!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
***S/P SERWRIT3
*
SUBROUTINE SERWRIT3 ( DATE , ETIKET , S , PTOIT, ETATOIT, IG, 1
+ PTOP, PREF, COEF,
+ DGRW, RGAS, GRAV, SATUES, SATUCO, INIT, WR)
*
#include "impnone.cdk"
CHARACTER *12 ETIKET
CHARACTER *8 ETIKET8
INTEGER DATE(14)
REAL S(*),DGRW,RGAS,GRAV
REAL PTOIT,ETATOIT
REAL PTOP, PREF, COEF
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
* 011 K. Winger (Apr 2006) - add writing of time-series version 2.00
* 012 B. Dugas (May 2006) - Do not automatically save time-series
* data at KOUNT=1 for version 2.00
*
*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, HEURE4
CHARACTER *8 TS_VERSION
*
IF ( NSTAT.LE.0 .AND. .not.wr) RETURN
IF (.NOT. INITOK) RETURN
*
NK = NINJNK(3)
IF ((INIT).and.(wr)) THEN
CONVERTI = 100.
IF (TSVER.NE.200) THEN
ETIKET8=ETIKET(1:8)
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),ETIKET8,NK,(S(K),K=1,NK),
U PTOIT,ETATOIT,(IG(K),K=1,4),
V DGRW, RGAS, GRAV, SATUES, SATUCO
ELSE
TS_VERSION="TSER_200"
WRITE ( NOUTSER ) TS_VERSION
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 PTOP, PREF, COEF, TSMOYHR, SRWRI,
W DGRW, RGAS, GRAV, SATUES, SATUCO
ENDIF
WRITE (6,*) ' ---ENTETE DE SERIES ECRITE SUR ',NOUTSER
ENDIF
*
IF ((KOUNT.EQ.1 .AND. TSVER.LT.200) .OR.
+ (MOD(KOUNT,SERINT) .EQ. 0) ) THEN
*
if (wr) then
if (TSVER.LT.200) then
HEURE4 = HEURE
WRITE ( NOUTSER ) HEURE4,((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)
else
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
endif
*
DO M=1,NSURF
SURFACE(M,2) = ' '
DO L=1,NSTAT
SERS(station(l),M) = 0.0
ENDDO
ENDDO
*
DO M=1,NPROF
PROFILS(M,2) = ' '
DO L=1,NSTAT
DO K=1,NK
SERP(K,station(l),M) = 0.0
ENDDO
ENDDO
ENDDO
*
ENDIF
*
RETURN
END