SUBROUTINE INITST(PBUF,KNI,KNJ,KNLVST,CDTYPE) #if defined (DOC) * ***s/r INITST - Initialization of the forecast error statistics * * *Author : C. Charette *ARMA/AES Jan 16 1996 *Revision: S. Pellerin *ARMA/AES Sept 97. * Change from TT to GZ state variables. * J. Halle *CMDA/AES Oct 99. * Add ground temperature (TG) tro the model state. * Y.J. Rochon *ARQX/MSC June 2005 * Removal of OZ*. No addition of TR* as routine not used. * * ------------------- ** Purpose: to initialize the forecast error correlation * . and standard deviation * *Arguments * i : PBUF : field read from statistics file * i : KNI,KNJ: dimension of input field * I : KNLVST : number of level in statistics file * i : CDTYPE : type of statistics #endif IMPLICIT NONE *implicits #include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "compstat.cdk"
* INTEGER KNI,KNJ,KNLVST REAL*8 PBUF(KNI,KNJ) CHARACTER*(*) CDTYPE C INTEGER ILEV,JI,JJ C IF(NFLEV .GT. 1) THEN IF(CDTYPE .EQ. 'UUCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV UUCORBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'VVCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV VVCORBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'GZCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV GZCORBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'QCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV QCORBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'UUSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ UUSTDBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'GZSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ GZSTDBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'QSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ QSTDBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ELSEIF(CDTYPE .EQ. 'TGSTD') THEN DO JJ = 1,NJ DO JI = 1,NI TGSTDBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ENDIF endif C IF(NFLEV .EQ. 1) THEN DO JJ = 1,KNLVST IF(NINT(VLEV(1)).EQ.MLVSTBG(JJ)) ILEV = JJ END DO WRITE(NULOUT,'(10X,"LEVEL SELECTED IN INITST = ",I4,/)')ILEV IF(CDTYPE .EQ. 'UUCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV UUCORBG(JI,JJ) = PBUF(ILEV,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'VVCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV VVCORBG(JI,JJ) = PBUF(ILEV,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'GZCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV GZCORBG(JI,JJ) = PBUF(ILEV,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'QCOR') THEN DO JJ = 1,NFLEV DO JI = 1,NFLEV QCORBG(JI,JJ) = PBUF(ILEV,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'UUSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ UUSTDBG(JI,JJ) = PBUF(JI,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'GZSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ GZSTDBG(JI,JJ) = PBUF(JI,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'QSTD') THEN DO JJ = 1,NFLEV DO JI = 1,NJ QSTDBG(JI,JJ) = PBUF(JI,ILEV) END DO END DO ELSEIF(CDTYPE .EQ. 'TGSTD') THEN DO JJ = 1,NJ DO JI = 1,NI TGSTDBG(JI,JJ) = PBUF(JI,JJ) END DO END DO ENDIF ENDIF RETURN END