!-------------------------------------- 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 --------------------------------------
!
SUBROUTINE INITGD0(PTRANS,KLEV,KNI,KNJ,KIG2,CDVAR) 4,1
*
#if defined (DOC)
*
***s/r INITGD0 - Transfer input grid-point trial fields
* to the model state-vector.
* WARNING!!!!!!!!!! :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
* L. Fillion *ARMA-MSC - 2 May 2005.
* . Extend the use to Limited-Area analysis.
* Luc Fillion *ARMA/EC - 10 Apr. 2007: Add warning comment above.
* Luc Fillion *ARMA/EC - 14 Aug 2007 - Update to v_10_0_3.
* Luc Fillion *ARMA/EC - 1st May 2009 - Include QQ,DD in grd_typ='LU' mode.
*
*Arguments
* i : PTRANS(KNI,KNJ) : field to be transferred
* i : KLEV : model level
* i : KNI, KNJ : must be .le. to NI, NJ
* 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 "comlun.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
*
**
INTEGER KLEV, KNI, KNJ, KIG2
CHARACTER*2 CDVAR
REAL*8 PTRANS(KNI,KNJ),ZCON, dix
C
CHARACTER*2 CLVAR
INTEGER JI, JJ
!
!!
if(grd_typ.eq.'LU') then
kig2=1
if((kni.gt.ni).or.(knj.gt.nj)) then
call abort3d(nulout,'INITGD0: Input kni,knj > analysis ni,nj')
endif
endif
!
C ---------------------------------------------------
C* THE TREATMENT OF GZ AND VT IS TEMPORARY.
C THESE TWO FIELDS ARE BEING PUT IN THE GZ0 FIELD
C ---------------------------------------------------
CLVAR=CDVAR
! write(nulout,*) 'initgd0: treating variable ',CDVAR
! write(nulout,*) 'initgd0: Argument dimensions passed: kni,knj = ',kni,knj
dix=1.0D1
C
C* 1. Input field is stored from North to South in Global case
C
100 CONTINUE
IF(KIG2.EQ.1) THEN
IF(CLVAR.EQ.'UU') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
UT0(JI,KLEV,JJ) = CONIMA(JJ)*PTRANS(JI,JJ)*RMSKNT ! build Wind-Images
END DO
END DO
ELSE IF(CLVAR.EQ.'VV') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = CONIMA(JJ)*PTRANS(JI,JJ)*RMSKNT ! build Wind-Images
END DO
END DO
ELSE IF(CLVAR.EQ.'DD') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'CC') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UC') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'QQ') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
UT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'PP') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
UT0(JI,KLEV,JJ) = PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'GP') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ) = PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GB') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ) = PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'TT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'VT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'GZ') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ)=PTRANS(JI,JJ)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'ES') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'LQ') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'HU') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'O3') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GOZ0(JI,KLEV,JJ)=PTRANS(JI,JJ)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'TR') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GTR0(JI,KLEV,JJ)=PTRANS(JI,JJ)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'P0') THEN
ZCON = 1.D2
DO JJ = 1, KNJ
DO JI = 1, KNI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'LP') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GPS0(JI,1,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'TG') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GTG0(JI,1,JJ)=PTRANS(JI,JJ)
END DO
END DO
ELSE IF(CLVAR.EQ.'UP') THEN
ZCON = 1.D2
DO JJ = 1, KNJ
DO JI = 1, KNI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,JJ)
END DO
END DO
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, KNJ
DO JI = 1, KNI
UT0(JI,KLEV,JJ) = CONIMA(JJ)*RMSKNT
S *PTRANS(JI,KNJ- JJ + 1)
END DO
END DO
ELSE IF(CLVAR .EQ.'VV') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = CONIMA(JJ)*RMSKNT
S *PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'CC') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'UC') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
VT0(JI,KLEV,JJ) = PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR .EQ.'PP') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
UT0(JI,KLEV,JJ) = PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'TT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'UT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'VT') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
TT0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'GZ') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GP') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'GB') THEN
ZCON = dix*RG
DO JJ = 1, KNJ
DO JI = 1, KNI
GZ0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)*ZCON
END DO
END DO
ELSE IF(CLVAR.EQ.'ES') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'HU') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'LQ') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
Q0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
END DO
END DO
ELSE IF(CLVAR.EQ.'O3') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GOZ0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'TR') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GTR0(JI,KLEV,JJ)=PTRANS(JI,KNJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'P0') THEN
ZCON = 1.D2
DO 241 JJ = 1, KNJ
DO 242 JI = 1, KNI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,KNJ-JJ+1)
242 CONTINUE
241 CONTINUE
ELSE IF(CLVAR.EQ.'LP') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GPS0(JI,1,JJ)=PTRANS(JI,KNJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'UP') THEN
ZCON = 1.D2
DO JJ = 1, KNJ
DO JI = 1, KNI
GPS0(JI,1,JJ)=ZCON*PTRANS(JI,KNJ-JJ+1)
ENDDO
ENDDO
ELSE IF(CLVAR.EQ.'TG') THEN
DO JJ = 1, KNJ
DO JI = 1, KNI
GTG0(JI,1,JJ)=PTRANS(JI,KNJ-JJ+1)
ENDDO
ENDDO
END IF
C
END IF
C
RETURN
END