SUBROUTINE INITGD0(PTRANS,KLEV,KNI,KNJ,KIG2,CDVAR) 3
*
#if defined (DOC)
*
***s/r INITGD0 - Transfer input grid-point trial fields
* to the model state-vector. This also involves a
* transformation from true winds to wind images.
*
*Author : Luc Fillion *RPN/AES - Aug 92
*Revision:
* P. GAUTHIER *ARMA/AES - Sept. 24, 1992
* . Restructuration of the code
* P. Gauthier *ARMA/AES - May 21, 1993
* . Conversion of winds from knots to m/s
* . RPN standard files require winds to be in knots
* P. Koclas *CMC/CMDA February 1994
* . - Handle cdvar = 'VT' inside
* routine instead of inside getfst.
* P. Koclas *CMC/CMDA August 1995
* . - Handle cdvar = 'ES' as moisture variable
* P. GAUTHIER *ARMA/AES - April 1996
* . Modifications on how to handle GZ and VT
* S. Pellerin *ARMA/AES Sept 97.
* Change from TT to GZ state variables.
* J. Halle *CMDA/AES - Oct 1999
* . Added ground temperature (TG) to the model state
* Y. Yang Oct. 2003
* - Added option for species
*
*Arguments
* i : PTRANS(KNI,KNJ) : field to be transferred
* i : KLEV : model level
* i : KNI, KNJ : equivalent to NI, NJ. Used to dimension PTRANS
* i : KIG2 : grid type according to the parameter IG2 of the
* . RPN standard files.
* i : CDVAR : variable type being transfer
*
#endif
*
IMPLICIT NONE
C
*
*IMPLICITS
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "comchem.cdk"
#include "comgd0.cdk"
*
**
INTEGER KLEV, KNI, KNJ, KIG2
CHARACTER*(*) CDVAR
REAL*8 PTRANS(KNI,KNJ),ZCON, dix
C
CHARACTER*4 CLVAR
INTEGER JI, JJ
INTEGER NN
C ---------------------------------------------------
C* THE TREATMENT OF GZ AND VT IS TEMPORARY.
C THESE TWO FIELDS ARE BEING PUT IN THE GZ0 FIELD
C ---------------------------------------------------
CLVAR=CDVAR
dix=1.0D1
C
C* 1. Input field is stored from North to South
C
100 CONTINUE
IF(KIG2.EQ.1) THEN
IF(CLVAR.EQ.'UU') THEN
DO JJ = 1, NJ
DO JI = 1, NI
UT0(JI,KLEV,JJ) = CONIMA(JJ)*PTRANS(JI,JJ)*RMSKNT
END DO
END DO
ELSE IF(CLVAR.EQ.'VV') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = CONIMA(JJ)*PTRANS(JI,JJ)*RMSKNT
END DO
END DO
ELSE IF(CLVAR.EQ.'CC') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UC') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'PP') THEN
DO JJ = 1, NJ
DO JI = 1, NI
UT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'GP') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ) = PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GB') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ) = PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'TT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'VT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'GZ') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ)=PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'ES') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'LQ') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'HU') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'P0') THEN
ZCON = 1.D2
DO JJ = 1, NJ
DO JI = 1, NI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'LP') THEN
DO JJ = 1, NJ
DO JI = 1, NI
GPS0(JI,1,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'TG') THEN
DO JJ = 1, NJ
DO JI = 1, NI
GTG0(JI,1,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UP') THEN
ZCON = 1.D2
DO JJ = 1, NJ
DO JI = 1, NI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,JJ)
END DO
END DO
ELSE
DO NN= 1,NGCMT
IF(CLVAR.EQ.CGCMT(NN)) THEN
DO JJ = 1, NJ
DO JI = 1, NI
GTR0(JI,(NN-1)*NFLEV+KLEV,JJ)=PTRANS(JI,JJ)
ENDDO
ENDDO
ENDIF
ENDDO
END IF
C
ELSE IF(KIG2.EQ.0) THEN
C
C* 2. Input field is stored from South to North
C
200 CONTINUE
C
IF(CLVAR .EQ.'UU') THEN
DO JJ = 1, NJ
DO JI = 1, NI
UT0(JI,KLEV,JJ) = CONIMA(JJ)*RMSKNT
S *PTRANS(JI,NJ- JJ + 1)
END DO
END DO
ELSE IF(CLVAR .EQ.'VV') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = CONIMA(JJ)*RMSKNT
S *PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'CC') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'UC') THEN
DO JJ = 1, NJ
DO JI = 1, NI
VT0(JI,KLEV,JJ) = PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'PP') THEN
DO JJ = 1, NJ
DO JI = 1, NI
UT0(JI,KLEV,JJ) = PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'TT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'UT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'VT') THEN
DO JJ = 1, NJ
DO JI = 1, NI
TT0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'GZ') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GP') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GB') THEN
ZCON = dix*RG
DO JJ = 1, NJ
DO JI = 1, NI
GZ0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'ES') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'HU') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'LQ') THEN
DO JJ = 1, NJ
DO JI = 1, NI
Q0(JI,KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'P0') THEN
ZCON = 1.D2
DO 241 JJ = 1, NJ
DO 242 JI = 1, NI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,NJ-JJ+1)
242 CONTINUE
241 CONTINUE
ELSE IF(CLVAR.EQ.'LP') THEN
DO JJ = 1, NJ
DO JI = 1, NI
GPS0(JI,1,JJ)=PTRANS(JI,NJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'UP') THEN
ZCON = 1.D2
DO JJ = 1, NJ
DO JI = 1, NI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,NJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'TG') THEN
DO JJ = 1, NJ
DO JI = 1, NI
GTG0(JI,1,JJ)=PTRANS(JI,NJ-JJ+1)
ENDDO
ENDDO
ELSE
DO NN= 1, NGCMT
IF(CLVAR.EQ.CGCMT(NN)) THEN
DO JJ = 1, NJ
DO JI = 1, NI
GTR0(JI,(NN-1)*NFLEV+KLEV,JJ)=PTRANS(JI,NJ-JJ+1)
ENDDO
ENDDO
ENDIF
ENDDO
END IF
C
END IF
C
RETURN
END