!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/P SERWRIT2 *SUBROUTINE SERWRIT2 ( DATE , ETIKET , S , PTOIT, ETATOIT, IG, 1,1 + DGRW, RGAS, GRAV, SATUES, SATUCO, INIT, WR) * #include "impnone.cdk"
CHARACTER *8 ETIKET INTEGER DATE(14) REAL S(*),DGRW,RGAS,GRAV REAL PTOIT,ETATOIT INTEGER IG(4) LOGICAL INIT,WR LOGICAL SATUES, SATUCO * *Author * R. Benoit (RPN 1984) * *Revision * 001 J. Cote RPN(January 1985) * - Recoding compatible SEF/RFE version * - Documentation * 002 M. Lepine - RFE model code revision project (Feb 87) * 003 B. Reid (June 89) - Zonal diagnostics * * 004 B. Bilodeau (December 89) * - Reduce writing out on the file NOUTZON * - Calculation of NK for allowing the execution of * zonal diagnostics with the time-series * 005 N. Brunet (May91) * New version of thermodynamic functions * and file of constants * 006 B. Bilodeau (July 1991)- Adaptation to UNIX * 007 G. Pellerin (Fev 1994) - Remove the code pertaining * to the zonal diagnostics package * 008 N. Ek (Mar 1995) - reduce output to only every SERINT * time-steps. * 009 B. Bilodeau (Feb 1997) - Eta coordinate. Rotation of winds * from GEF grid to lat-lon grid. * 010 B. Bilodeau (July 1998) - Automate IBM32 to IEEE conversion * *Object * to write the heading and the records of time-series data * to OMSORTI * *Arguments * * - Input - * DATE date array * ETIKET label for forecast * S sigma (or eta) levels * PTOIT pressure value at the model top * ETATOIT eta value at the model top * IG IG1, IG2, IG3 and IG4 of the grid descriptors ^^ and >> * DGRW east-west orientation of the polar sterographical grid or * latitude-longitude * RGAS gas constant for dry air * GRAV acceleration due to gravity * SATUES .TRUE. if water/ice phase for saturation * (pre/post processing pgms) * .FALSE. if water phase only for saturation * (pre/post processing pgms) * SATUCO .TRUE. if water/ice phase for saturation * .FALSE. if water phase only for saturation * INIT .TRUE. for writing heading * .FALSE. for no writing out heading * *Notes * See SERDBU for more information * *IMPLICITES * #include "sercmdk.cdk"
* *MODULE EXTERNAL SERDATA * * ** * INTEGER K,L,M,NK REAL CONVERTI * IF ( NSTAT.LE.0) THEN CALL SERDATA
if (.not.wr) RETURN ENDIF * IF (.NOT. INITOK) THEN RETURN ENDIF * NK = NINJNK(3) IF ((INIT).and.(wr)) THEN CONVERTI = 100. WRITE ( NOUTSER ) CONVERTI, NSTAT_g, X (ISTAT_g(L),JSTAT_g(L),L=1,NSTAT_g), Y NSURF,(SURFACE(M,2),M=1,NSURF), Z NPROF,(PROFILS(M,2),M=1,NPROF), T (DATE(K),K=1,14),ETIKET,NK,(S(K),K=1,NK), U PTOIT,ETATOIT,(IG(K),K=1,4), V DGRW, RGAS, GRAV, SATUES, SATUCO WRITE (6,*) ' ---ENTETE DE SERIES ECRITE SUR ',NOUTSER ENDIF * IF ( (KOUNT.NE.1) .AND. (MOD(KOUNT,SERINT) .NE. 0) ) RETURN * if (wr) then WRITE ( NOUTSER ) HEURE,((SERS(L,M),L=1,NSTAT_g),M=1,NSURF), X (((SERP(K,L,M),K=1,NK),L=1,NSTAT_g),M=1,NPROF) endif * DO 1 M=1,NSURF SURFACE(M,2) = ' ' DO 1 L=1,NSTAT 1 SERS(station(l),M) = 0.0 * DO 2 M=1,NPROF PROFILS(M,2) = ' ' DO 2 L=1,NSTAT DO 2 K=1,NK 2 SERP(K,station(l),M) = 0.0 * RETURN END