SUBROUTINE GDOUT2(CPVAR,pptrans,kni,knj,KLEV,lplok,kip1) 7
#if defined (DOC)
*
***s/r GDOUT2 - Transfert of the content of COMGD0 on a RPN
* . standard file
*
*Author : P. Gauthier *ARMA/AES June 9, 1992
*Revision:
* P. Gauthier *ARMA/AES Oct. 22, 1993: control of postprocessing
* . through the comdeck COMPOST
* P. Gauthier *ARMA/AES May 25, 1993:
* . Transfer of specific humidity and surface
* . pressure on file (only if defined in the model
* . state.
* P. Koclas *CMC/CMDA February 1994
* . -ip3 now= KITER in call to fstecr.
* -Add arguments CDTYPV KSTAMP.
* -Replace comdeck "comtrl" by "compost"
* L. Fillion *ARMA/AES Nov 1994:
* Output height field in decameters.
* C. Charette *ARMA/AES Jan 96
* -Read RPN standard file parameters from 'compost'
* P. Gauthier *ARMA/AES Dec. 1996
* . -Add the variables relative (QR)and absolute (QQ)
* . vorticity, streamfunction (PP), velocity potential
* . (CC) and divergence (DD) in the possible choices for
* . output (these fields are computed within POSTPROC
* . and are transferred to GDOUT via the comdeck
* . "localpost.cdk". This mechanism will allow for the
* . computation of diagnostic quantities and their transfer
* . The control remains the same as before: through NPPCVAR
* . (total number of variables to write) and their names
* . in CPVAR(*) defined in COMPOST.
* S. Pellerin *ARMA/AES Sept 97.
* Introduction of Ozone and Passive tracer.
* S. Pellerin *ARMA/AES Oct 97
* -Introduction of NIP1s from COMGEM
* -Modification in subroutine parameters (arguments).
* -Output of total ozone O3 (DU)
* M Buehner July 98
* -Get rid of check on level for 2D fields, since this
* caused subroutine to return before writing any 3D fields
* listed after a 2D field
* -Moved IP1= statement inside variables loop
* L. Fillion *ARMA/AES 16 nov 98
* - Adapt GZ and ES diagnostic output
* C. Charette *ARMA/AES 26 nov 98
* - Adapt HU, VT diagnostic output
* L. Fillion *ARMA/AES 4 dec 98
* - Allow output of TTB,TTU,GZB,GZU,PSB,PSU
* S. Pellerin *ARMA/SMC May 2000
* -Arguments modification for call in varout.ftn
* JM Belanger CMDA/SMC Oct 2000
* . 32 bits conversion
* C. Charette *ARMA/SMC - Sept 2004
* - Conversion to hybrid vertical coordinate
* Y. Yang Sep. 2004
* - Added include "comchem.cdk"
* - Added loops for species
* Y. Yang Feb. 2005
* - Removed 'O3' part as ozone is now part of 'TR'
*
*Arguments
* i CPVAR : variable name
* i kni,knj : dimension of vector pptrans
* i KLEV : index of the level to be transferred
* OUTPUT
* o pptrans : vector containing the variable
* o lplok : logical indicating if the variable has been
* implemented
* o kip1 : ip1 of the corresponding level
*
#endif
C
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "comchem.cdk"
#include "comcva.cdk"
#include "comgd0.cdk"
#include "compost.cdk"
*
INTEGER kni,knj,klev,kip1
real*8 pptrans(kni,knj)
character*(*) cpvar
logical lplok
*
INTEGER JLON, JGL,ig2
REAL*8 ZTEMP, ZGEOP, ZDAM, ZCON, un, dix
INTEGER JJ
#include "localpost.cdk"
C
IG2 = NIG2
kiP1 = NIP1(kLEV)
un = 1.0D0
dix = 1.0D1
C
C 2. Transfer of the fields of COMGD to an internal buffer
C . -----------------------------------------------------
C
c SET DIAGNOSTIC VARIABLES ON IF FIRST VAR IS PP (for GENINCR branch)
c
lplok = .true.
C
C . 2.1 Fields associated with model variables
C
IF(CPVAR.EQ.'TT') THEN
C
C * Temperature field
C
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = TT0(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'TB') THEN
C
C * Balanced Temperature field
C
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZTTB(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'TU') THEN
C
C * Unbalanced Temperature field
C
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZTTU(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'UT') THEN
C
C * Unbalanced Temperature field for stat
C
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZTP(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'VT') THEN
C
C * Virtual temperature field
C
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZTV(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'GZ') THEN
C
C * Geopotential field
C
ZGEOP = dix * RG
ZDAM = un/ZGEOP
c
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZDAM * zgz(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'ZB') THEN
C
C * Balanced Geopotential field
C
ZGEOP = dix * RG
ZDAM = un/ZGEOP
c
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZDAM * zgzb(JLON,KLEV,JGL)
END DO
END DO
ELSE IF(CPVAR.EQ.'ZU') THEN
C
C * Unbalanced Geopotential field
C
ZGEOP = dix * RG
ZDAM = un/ZGEOP
c
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZDAM * zgzu(JLON,KLEV,JGL)
END DO
END DO
C
C * Zonal wind component (in Knots)
C
ELSE IF(CPVAR.EQ.'UU') THEN
DO JGL = 1, NJ
DO JLON = 1, NI
PPTRANS(JLON,JGL) = UT0(JLON,KLEV,JGL)
S *CONPHY(JGL)*RKNTMS
END DO
END DO
C
C * Meridional wind component (in Knots)
C
ELSE IF(CPVAR.EQ.'VV') THEN
DO JGL = 1, NJ
DO JLON = 1, NI
PPTRANS(JLON,JGL) = VT0(JLON,KLEV,JGL)
S *CONPHY(JGL)*RKNTMS
END DO
END DO
C
C * Humidity field
C
ELSE IF(CPVAR.EQ.'ES') THEN
if(chum .eq. 'LQ') then
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = zes(JLON,KLEV,JGL)
END DO
END DO
elseif(chum .eq. 'ES') then
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = Q0(JLON,KLEV,JGL)
END DO
END DO
endif
C
ELSE IF(CPVAR.EQ.'LQ') THEN
IF(CHUM .EQ. 'LQ')THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = Q0(JLON,KLEV,JGL)
END DO
END DO
ELSEIF(CHUM .EQ. 'ES')THEN
LPLOK = .FALSE.
WRITE(NULOUT,*)' ****************************************'
WRITE(NULOUT,'(" GDOUT2: THE REQUESTED FIELD LQ IS NOT "
& ,"SUPPORTED WHEN CVCORD= ",A8," AND CHUM= ",A2)')
& CVCORD,CHUM
WRITE(NULOUT,*)' ****************************************'
ENDIF
C
ELSE IF(CPVAR.EQ.'HU') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = zhu(JLON,KLEV,JGL)
END DO
END DO
C
C * Surface Pressure from units of Pascal to millibar
C
ELSE IF(CPVAR.EQ.'P0') THEN
kip1=0
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = GPS0(JLON,1,JGL)*RPATMB
END DO
END DO
C
C * Ground temperature in Kelvin
C
ELSE IF(CPVAR.EQ.'TG') THEN
kip1=0
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = GTG0(JLON,1,JGL)
END DO
END DO
c
else if (LVARDIAG) then
C
C . 2.2 Diagnostic fields produced in DIAG3DVAR
C
220 CONTINUE
C
C Relative vorticity
C
IF(CPVAR.EQ.'QR') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZQR(JLON,KLEV,JGL)
END DO
END DO
C
C Absolute vorticity
C
ELSE IF(CPVAR.EQ.'QQ') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZQQ(JLON,KLEV,JGL)
END DO
END DO
C
C Divergence
C
ELSE IF(CPVAR.EQ.'DD') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZDD(JLON,KLEV,JGL)
END DO
END DO
C
C Velocity potential
C
ELSE IF(CPVAR.EQ.'CC') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZCC(JLON,KLEV,JGL)
END DO
END DO
C
C Unbalanced Velocity potential
C
ELSE IF(CPVAR.EQ.'UC') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZUC(JLON,KLEV,JGL)
END DO
END DO
C
C Stream function
C
ELSE IF(CPVAR.EQ.'PP') THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZPP(JLON,KLEV,JGL)
END DO
END DO
C
C * 2.3 OTHER SURFACE FIELDS
C
C
230 CONTINUE
ELSE IF(CPVAR.EQ.'PB') THEN
C
C Balanced surface-pressure
C
kip1 = 0
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = zpsb(JLON,JGL)*RPATMB
END DO
END DO
ELSE IF(CPVAR.EQ.'PU') THEN
C
C Unbalanced surface-pressure
C
kip1 = 0
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = zpsu(JLON,JGL)*RPATMB
END DO
END DO
ELSE IF(CPVAR.EQ.'UP') THEN
C
C Unbalanced surface-pressure for stat
C
kip1 = 0
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = ZLPP(JLON,1,JGL)*1.0D-2
END DO
END DO
else
C
C Chemistry fields
C
DO JJ = 1, NGCMT
IF(CPVAR .eq. CGCMT(JJ)) THEN
DO JLON = 1, NI
DO JGL = 1, NJ
PPTRANS(JLON,JGL) = GTR0(JLON,(JJ-1)*NFLEV+KLEV,JGL)
END DO
END DO
LPLOK = .TRUE.
go to 400
ENDIF
ENDDO
LPLOK = .FALSE.
WRITE(NULOUT,*)' ****************************************'
WRITE(NULOUT,'(" GDOUT2: THE DIAGNOSTIC FIELD IS NOT "
& ,"SUPPORTED CPVAR= ",A2)')CPVAR
WRITE(NULOUT,*)' ****************************************'
endif
C
400 continue
C
else
LPLOK = .FALSE.
WRITE(NULOUT,*)' ****************************************'
WRITE(NULOUT,'(" GDOUT2: THE FOLLOWING FIELD IS NOT "
& ,"SUPPORTED CPVAR= ",A2)')CPVAR
WRITE(NULOUT,*)' ****************************************'
END IF
IF ( IG2 .EQ. 0 .and. lplok) THEN
DO 262 JLON = 1, NI
DO 263 JGL = 1, NJ/2
ZTEMP=PPTRANS(JLON,JGL)
PPTRANS(JLON,JGL)=PPTRANS(JLON,NJ-JGL+1)
PPTRANS(JLON,NJ-JGL+1)=ZTEMP
263 CONTINUE
262 CONTINUE
ENDIF
C
RETURN
END