SUBROUTINE INIT C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: INIT INITIALIZE VARIABLE FOR MODEL RUN C PRGRMMR: JANJIC ORG: W/NP22 DATE: ??-??-?? C C ABSTRACT: INIT READS IN PRIMARY AND AUXILIARY VARIABLES AND CONSTANTS C AND SETS INITIAL VALUES FOR OTHERS C C PROGRAM HISTORY LOG: C 87-06-?? JANJIC - C 92-10-27 DEAVEN - CHANGED READS OF NHB, NFC, AND NBC TO C ACCOMODATE SHORTENED RECORD LENGTHS C 95-03-27 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL C 96-10-31 BLACK - ADDED NAMELIST BCEXDATA FOR THE NESTS C 98-06-10 ROGERS - MADE Y2K COMPLIANT BY REPLACING CALL TO W3FI13 C TO W3DOXDAT C 98-09-04 PYLE - CHANGED TO NOT RE-INITIALIZE TSHLTR AND QSHLTR IF C RESTART=TRUE C 98-10-21 BLACK - CHANGES FOR DISTRIBUTED MEMORY C 98-11-17 BLACK - ADDED CODE TO LOCATE THE INNER DOMAIN BOUNDARIES C ON THE RELEVANT PE's C C C USAGE: CALL INIT FROM MAIN PROGRAM EBU C C INPUT ARGUMENT LIST: C NONE C C OUTPUT ARGUMENT LIST: C NONE C C INPUT FILES: C NFC - THE INITIAL VALUES OF SFC PRESSURE, T, Q, U, AND V C NHB - A LARGE VARIETY OF ARRAY AND SCALAR CONSTANTS C NBC - THE BOUNDARY CONDITIONS AND TENDENCIES C C OR C C RESTRT - A RESTART FILE WITH ALL NECESSARY QUANTITIES C C OUTPUT FILES: C NONE C C SUBPROGRAMS CALLED: C UNIQUE: READ_NHB C READ_RESTRT C ZERO2 C ZERO3 C UTILITIES: W3LIB - W3DOXDAT C NONE C LIBRARY: C COMMON - CTLBLK C LOOPS C MASKS C DYNAM C PHYS2 C MAPOT1 C VRBLS C PVRBLS C BOCO C GRIDS C ACMCLH C ACMCLD C ACMPRE C ACMRDL C ACMRDS C ACMSFC C CLDWTR C CNVCLD C CUINIT C SOIL C INDX C TEMPV C RD1TIM C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE : IBM SP C$$$ C C----------------------------------------------------------------------- C INCLUDE/SET PARAMETERS. C----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "parm.tbl" INCLUDE "cuparm" INCLUDE "parmsoil" INCLUDE "mpp.h" INCLUDE "mpif.h" #include "sp.h" C----------------------------------------------------------------------- P A R A M E T E R & (CM1=2937.4,CM2=4.9283,CM3=23.5518,EPS=0.622,PI2=2.*3.14159265 &, RLAG=14.8125 C CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV C &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=1.0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=.50,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=0.0 &, Q2INI=.50 ,EPSQ2=0.2 ,EPSWET=0.0 CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA &, Z0LAND=.10,Z0SEA=.001,FCM=.00001 &, DTR=0.1745329E-1) C----------------------------------------------------------------------- P A R A M E T E R & (A1=610.78,WA=.10,WG=1.0-WA) C C----------------------------------------------------------------------- P A R A M E T E R & (IMJM=IM*JM-JM/2,JMP1=JM+1,JAM=6+2*(JM-10),LB=2*IM+JM-3 &, LM1=LM-1,LP1=LM+1,IMT=2*IM-1 &, NSTAT=1000) C----------------------------------------------------------------------- C C DECLARE VARIABLES C C----------------------------------------------------------------------- L O G I C A L & RUN,RUNB,FIRST,RESTRT,SIGMA,EXBC,NEST &,INSIDEH,INSIDEV C----------------------------------------------------------------------- C H A R A C T E R *32 & LABEL C H A R A C T E R *40 & CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV &,FILCLD,FILRAD,FILSFC C----------------------------------------------------------------------- R E A L & PHALF(LP1),NPEBND C*** C*** NOTE: THE DIMENSION OF THE FOLLOWING ARRAYS IS ARBITRARILY CHOSEN C*** TO EXCEED ANY NUMBER OF BOUNDARY POINTS THAT MIGHT EXIST IN C*** ANY INNER DOMAIN C*** R E A L & HLATI(1500),HLONI(1500),VLATI(1500),VLONI(1500) &,THLONI(1500),THLATI(1500),TVLONI(1500),TVLATI(1500) &,TSLAT(NSTAT),TSLON(NSTAT) C----------------------------------------------------------------------- I N T E G E R & IDATB(3),INIDAT(8),IBCDAT(8) C----------------------------------------------------------------------- #ifdef DP_REAL LOGICAL*8 RUNBX INTEGER*8 IDATBX(3),IHRSTBX #endif C----------------------------------------------------------------------- C C INCLUDE COMMON BLOCKS. C INCLUDE "CTLBLK.comm" INCLUDE "LOOPS.comm" INCLUDE "MASKS.comm" INCLUDE "DYNAM.comm" INCLUDE "PHYS2.comm" INCLUDE "MAPOT1.comm" INCLUDE "VRBLS.comm" INCLUDE "CONTIN.comm" INCLUDE "PVRBLS.comm" INCLUDE "BOCO.comm" INCLUDE "ACMCLH.comm" INCLUDE "ACMCLD.comm" INCLUDE "ACMPRE.comm" INCLUDE "ACMRDL.comm" INCLUDE "ACMRDS.comm" INCLUDE "ACMSFC.comm" INCLUDE "CLDWTR.comm" INCLUDE "CNVCLD.comm" INCLUDE "SOIL.comm" INCLUDE "INDX.comm" INCLUDE "Z0EFFT.comm" INCLUDE "TEMPV.comm" INCLUDE "PPTASM.comm" INCLUDE "QFLX.comm" C----------------------------------------------------------------------- C*** C*** THE FOLLOWING IS FOR TIMIMG PURPOSES ONLY C*** real*8 timef real nhb_tim common/timing/surfce_tim,nhb_tim,res_tim,exch_tim C----------------------------------------------------------------------- C O M M O N /RD1TIM/ 1 K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1 2,LVL(IDIM1:IDIM2,JDIM1:JDIM2) C----------------------------------------------------------------------- D A T A 1 PLOMD/64200./,PMDHI/35000./,PHITP/15000./,P400/40000./ 2,PLBTM/105000./ D A T A 1 NFILE/14/,IUNWGT/40/ !----------------------------------------------------------------------- ! !--- Flag for initializing convective clouds for radiation ! COMMON /CUINIT/ CURAD LOGICAL CURAD C----------------------------------------------------------------------- C C DECLARE NAMELISTS. C NAMELIST /FCSTDATA/ & TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL &,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP &,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC &,NEST CHARACTER ENVAR*4 C C Read in precip assim test points (global), compute the corresponding C local coordinate C and the node it is on c CALL get_environment_variable("tmmark",ENVAR) c itest=56 c jtest=33 c IF(ENVAR.NE.'tm00') then c READ(5,*) ITEST, JTEST c print*,'itest,jtest,mype=',itest,jtest,mype c CALL GLB2LOC(ITEST,JTEST,ITSTLOC,JTSTLOC,MTSTPE) c ENDIF itstloc=39 jtstloc=26 mtstpe=5 C C*********************************************************************** C START INIT HERE. C C CALCULATE THE I-INDEX EAST-WEST INCREMENTS C DO J=1,JM IHEG(J)=MOD(J+1,2) IHWG(J)=IHEG(J)-1 IVEG(J)=MOD(J,2) IVWG(J)=IVEG(J)-1 ENDDO C C CALCULATE THE INDIRECT I INDICES FOR RADTN C KNT=0 DO I=1,IM KNT=KNT+1 IRADG(KNT)=I ENDDO DO I=1,IM-1 KNT=KNT+1 IRADG(KNT)=IM+2+I ENDDO C C ZERO OUT LOCALLY INDEXED ARRAYS C CALL ZERO2(PDSL) CALL ZERO3(T,LM) CALL ZERO3(Q,LM) CALL ZERO3(U,LM) CALL ZERO3(V,LM) CALL ZERO2(RES) CALL ZERO3(RTOP,LM) CALL ZERO3(OMGALF,LM) CALL ZERO3(DIV,LM) CALL ZERO3(ETADT,LM-1) CALL ZERO3(HTM,LM) CALL ZERO3(VTM,LM) CALL ZERO2(HBM2) CALL ZERO2(AKMS) CALL ZERO2(UZ0) CALL ZERO2(VZ0) CALL ZERO2(FAD) C--------------------------------------------------------------- C C READ Z0 EFFECTIVE C DO N=1,4 IF(MYPE.EQ.0)THEN READ(22)TEMP1 ENDIF CALL DSTRB(TEMP1,ZEFFIJ,1,4,N) ENDDO C--------------------------------------------------------------- C*** C*** READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB C*** NHB=12 LSL =LSM btim=timef() CALL READ_NHB(NHB) nhb_tim=timef()-btim C C--------------------------------------------------------------- NHIBU = 12 IF(MYPE.EQ.0)WRITE(LIST,*)'INIT: READ CONSTANTS FILE' C C C READ NAMELIST FCSTDATA WHICH CONTROLS TIMESTEPS, C ACCUMULATION PERIODS, STANDARD OUTPUT C RESTRT = .FALSE. REWIND 11 READ(11,FCSTDATA) C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: READ NAMELIST FCSTDATA - LISTED BELOW' WRITE(LIST,*)' TSTART,TEND : ',TSTART,TEND WRITE(LIST,*)' TCP : ',TCP WRITE(LIST,*)' RESTRT : ',RESTRT WRITE(LIST,*)' SINGLRST : ',SINGLRST WRITE(LIST,*)' SUBPOST : ',SUBPOST WRITE(LIST,*)' NMAP,NPHS : ',NMAP,NPHS WRITE(LIST,*)' NCNVC : ',NCNVC WRITE(LIST,*)' NRADSH,NRADLH: ',NRADSH,NRADLH WRITE(LIST,*)' NTDDMP : ',NTDDMP WRITE(LIST,*)' TPREC,THEAT : ',TPREC,THEAT WRITE(LIST,*)' TCLOD,TRDSW : ',TCLOD,TRDSW WRITE(LIST,*)' TRDLW,TSRFC : ',TRDLW,TSRFC WRITE(LIST,*)' TSHDE (POSTED FORECAST HOURS) BELOW: ' WRITE(LIST,75) (TSHDE(K),K=1,99) WRITE(LIST,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' WRITE(LIST,80) (SPL(L),L=1,LSM) 75 FORMAT(14(F4.1,1X)) 80 FORMAT(8(F8.1,1X)) ENDIF C C C SET TIME STEPPING RELATED CONSTANTS. C FIRST = .TRUE. NSTART = INT(TSTART*TSPH+0.5) NTSTM = INT(TEND *TSPH+0.5)+1 NCP = INT(TCP *TSPH+0.5) NPREC = INT(TPREC *TSPH+0.5) NHEAT = INT(THEAT *TSPH+0.5) NCLOD = INT(TCLOD *TSPH+0.5) NRDSW = INT(TRDSW *TSPH+0.5) NRDLW = INT(TRDLW *TSPH+0.5) NSRFC = INT(TSRFC *TSPH+0.5) IF(MYPE.EQ.0)THEN WRITE(0,*)' NTSTM=',NTSTM,' TSPH=',TSPH,' DT=',DT ENDIF C IF (NSTART.LT.NCP) NSTART=0 C C SET VARIOUS PHYSICS PACKAGE TIMESTEP VARIABLES. C NRADS = NINT(TSPH)*NRADSH NRADL = NINT(TSPH)*NRADLH DTQ2 = NPHS * DT TDTQ2 = DTQ2 + DTQ2 DTD = 0.5 * DTQ2 TDTD = DTD + DTD KTM = INT(DTQ2/DTD+0.5) C IF(MYPE.EQ.0)THEN WRITE(LIST,*)' ' WRITE(LIST,*)'SET TIME STEPPING CONSTANTS' WRITE(LIST,*)' FIRST : ',FIRST WRITE(LIST,*)' NSTART,NSTSM,NCP : ',NSTART,NTSTM,NCP WRITE(LIST,*)' NTDDMP,NPREC,NHEAT: ',NTDDMP,NPREC,NHEAT WRITE(LIST,*)' NCLOD,NRDSW,NRDLW : ',NCLOD,NRDSW,NRDLW WRITE(LIST,*)' NSRFC : ',NSRFC WRITE(LIST,*)' NRADS,NRADL,KTM : ',NRADS,NRADL,KTM WRITE(LIST,*)' DTQ2,TDTQ2 : ',DTQ2,TDTQ2 WRITE(LIST,*)' DTD,TDTD : ',DTD,TDTD WRITE(LIST,*)' ' ENDIF C C COMPUTE DERIVED MAP OUTPUT CONSTANTS. DO L = 1,LSL ALSL(L) = LOG(SPL(L)) ENDDO DO I=1,NMAP ISHDE(I)=INT(TSHDE(I)*TSPH+0.5)+1 ENDDO C*** C*** SET UP ARRAY IRAD (INDICES FOR RADTN) C*** DO I=MYIS,MYIE IRAD(I)=IRADG(I+MY_IS_GLB-1)-MY_IS_GLB+1 ENDDO C------------------------------------------------------------- C*** C*** READ INITIAL CONDITIONS OR RESTART FILE. C*** btim=timef() IF(SINGLRST)THEN CALL READ_RESTRT ELSE CALL READ_RESTRT2 ENDIF res_tim=timef()-btim C------------------------------------------------------------- C CALL READGRDETA C C------------------------------------------------------------- C C IF NOT RUNNING THE MODEL, PRINT DATE OF INITIAL CONDITIONS C JUST READ AND STOP. OTHERWISE, CONTINUE. C C------------------------------------------------------------- IF (RUN) GO TO 190 C IF(MYPE.EQ.0)THEN WRITE(LIST,165) IHRST,IDAT WRITE(LIST,166) ccccc CALL EXIT(2) CALL MPI_FINALIZE(IERR) STOP2 165 FORMAT('0*** ',I2,' GMT ',2(I2,'/'),I4,' ***') 166 FORMAT('0F*** NO INITIAL CONDITIONS. RUN TERMINATED.') ENDIF C C IF THE TIMESTEP COUNTER (NTSD) EXCEEDS THE "STOP MODEL" T C TIMESTEP,CONTINUE, STOP EXECUTION. OTHERWISE, CONTINUE. C 190 IF(NTSD.GE.NTSTM)THEN IF(MYPE.EQ.0)THEN WRITE(LIST,165) IHRST,IDAT WRITE(LIST,195) 195 FORMAT('0F*** FORECAST ALREADY DONE. RUN TERMINATED.') ccccc CALL EXIT(3) CALL MPI_FINALIZE(IERR) STOP3 ENDIF ENDIF C C------------------------------------------------------------- C C READ BOUNDARY CONDITIONS. C C------------------------------------------------------------- IF(MYPE.EQ.0)THEN IF(NEST)THEN KBI=2*IM+JM-3 KBI2=KBI-4 LRECBC=4*(1+(1+6*LM)*KBI*2+(KBI+KBI2)*(LM+1)) OPEN(UNIT=NBC,ACCESS='DIRECT',RECL=LRECBC) ENDIF C IF(.NOT.NEST)REWIND NBC C #ifdef DP_REAL IF(NEST)THEN READ(NBC,REC=1)RUNBX,IDATBX,IHRSTBX,TBOCO ELSE READ(NBC)RUNBX,IDATBX,IHRSTBX,TBOCO ENDIF C RUNB=RUNBX IDATB=IDATBX IHRSTB=IHRSTBX #else IF(NEST)THEN READ(NBC,REC=1)RUNB,IDATB,IHRSTB,TBOCO ELSE READ(NBC)RUNB,IDATB,IHRSTB,TBOCO ENDIF #endif ENDIF C CALL MPI_BCAST(RUNB,1,MPI_LOGICAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(IDATB,3,MPI_INTEGER,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(IHRSTB,1,MPI_INTEGER,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(TBOCO,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) C CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) C IF(MYPE.EQ.0.AND..NOT.NEST)THEN ISTART=NINT(TSTART) C READ(NBC)BCHR 205 READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) C IF(ISTART.EQ.NINT(BCHR))THEN IF(ISTART.GT.0)READ(NBC)BCHR GO TO 215 ELSE READ(NBC)BCHR ENDIF C IF(ISTART.GE.NINT(BCHR))GO TO 205 ENDIF C IF(MYPE.EQ.0.AND.NEST)THEN ISTART=NINT(TSTART) NREC=1 C 210 NREC=NREC+1 READ(NBC,REC=NREC)BCHR C IF(ISTART.EQ.NINT(BCHR))THEN IF(ISTART.GT.0)READ(NBC,REC=NREC+1)BCHR GO TO 215 ELSE GO TO 210 ENDIF ENDIF C 215 CONTINUE C CALL MPI_BCAST(BCHR,1,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) C CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) C IF(MYPE.EQ.0)WRITE(LIST,*)' READ UNIT NBC=',NBC C*** C*** COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ C*** NBOCO=NINT(BCHR*TSPH) C IF(NTSD.EQ.0)THEN IF(MYPE.EQ.0.AND..NOT.NEST)THEN BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC WRITE(LIST,*)' BACKSPACE UNIT NBC=',NBC ENDIF ENDIF C C------------------------------------------------------------- C C SET ARRAYS CONTROLLING POST PROCESSING. C C------------------------------------------------------------- IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: READ IOUT,NSHDE,NTSD=',IOUT,NSHDE,NTSD ENDIF C DO I=1,NMAP IOUT=I IF(ISHDE(I).GE.NTSD)GO TO 220 ENDDO 220 NSHDE = ISHDE(IOUT) C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: SET IOUT,NSHDE =',IOUT,NSHDE, 1 ' FOR ISHDE,NTSD=',ISHDE(IOUT),NTSD ENDIF C------------------------------------------------------------- C C INITIALIZE PHYSICS VARIABLES IF STARTING THIS RUN FROM SCRATCH. C IF(NEST)THEN DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) C LLMH=LMH(I,J) C IF(T(I,J,LLMH).EQ.0.)THEN T(I,J,LLMH)=T(I,J,LLMH-1) ENDIF C TERM1=-0.068283/T(I,J,LLMH) PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1) ENDDO ENDDO ENDIF C IF(.NOT.RESTRT)THEN DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) LLMH=LMH(I,J) PDSL(I,J) = PD(I,J)*RES(I,J) PREC(I,J) = 0. ACPREC(I,J) = 0. CUPREC(I,J) = 0. VAPINC(I,J)=0. VAPINC7(I,J)=0. CLDINC(I,J)=0. CLDINC7(I,J)=0. Z0(I,J) = SM(I,J)*Z0SEA+(1.-SM(I,J))* 1 (FIS(I,J)*FCM+Z0LAND) QS(I,J) = 0. AKMS(I,J) = 0. AKHS(I,J) = 0. TWBS(I,J) = 0. QWBS(I,J) = 0. CLDEFI(I,J) = 1. HTOP(I,J) = 100. HBOT(I,J) = 0. C*** C*** AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE C*** OF THE SURFACE AND OF THE SUBGROUND. C*** EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE. C*** ALSO DO THE SHELTER PRESSURE. C*** PM1=PDSL(I,J)*AETA(LLMH)+PT APEM1=(1.E5/PM1)**CAPA THS(I,J)=T(I,J,LLMH)*(1.+0.608*Q(I,J,LLMH))*APEM1 TSFCK=T(I,J,LLMH)*(1.+0.608*Q(I,J,LLMH)) PSFCK=PD(I,J)+PT C IF(SM(I,J).LT.0.5) THEN QS(I,J)=PQ0/PSFCK*EXP(A2*(TSFCK-A3)/(TSFCK-A4)) ELSEIF(SM(I,J).GT.0.5) THEN THS(I,J)=SST(I,J)*(1.E5/(PD(I,J)+PT))**CAPA ENDIF C TERM1=-0.068283/T(I,J,LLMH) PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1) C USTAR(I,J)=0.1 THZ0(I,J)=THS(I,J) QZ0(I,J)=QS(I,J) UZ0(I,J)=0. VZ0(I,J)=0. C ENDDO ENDDO C C INITIALIZE CLOUD FIELDS C DO L=1,LM DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) CWM(I,J,L)=0. ENDDO ENDDO ENDDO C C INITIALIZE ACCUMULATOR ARRAYS TO ZERO. C ARDSW=0.0 ARDLW=0.0 ASRFC=0.0 AVRAIN=0.0 AVCNVC=0.0 C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ACFRCV(I,J)=0. NCFRCV(I,J)=0 ACFRST(I,J)=0. NCFRST(I,J)=0 ACSNOW(I,J)=0. ACSNOM(I,J)=0. SSROFF(I,J)=0. BGROFF(I,J)=0. ALWIN(I,J) =0. ALWOUT(I,J)=0. ALWTOA(I,J)=0. ASWIN(I,J) =0. ASWOUT(I,J)=0. ASWTOA(I,J)=0. SFCSHX(I,J)=0. SFCLHX(I,J)=0. SUBSHX(I,J)=0. SNOPCX(I,J)=0. SFCUVX(I,J)=0. SFCEVP(I,J)=0. POTEVP(I,J)=0. POTFLX(I,J)=0. ENDDO ENDDO C C INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER. C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) IF(SM(I,J).GT.0.5)THEN CLOGES =-CM1/SST(I,J)-CM2*ALOG10(SST(I,J))+CM3 ESE = 10.**(CLOGES+2.) QS(I,J)= SM(I,J)*EPS*ESE/(PD(I,J)+PT-ESE*(1.-EPS)) ENDIF ENDDO ENDDO C C PAD GROUND WETNESS IF IT IS TOO SMALL. C c DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) c DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) c WET(I,J)=AMAX1(WET(I,J),EPSWET) c ENDDO c ENDDO C C INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL C VALUE (EPSQ2) ABOVE GROUND. SET TKE TO ZERO IN THE C THE LOWEST MODEL LAYER. IN THE LOWEST TWO ATMOSPHERIC C ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI). C DO L=1,LM1 DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) Q2(I,J,L)=HTM(I,J,L+1)*HBM2(I,J)*EPSQ2 ENDDO ENDDO ENDDO C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) Q2(I,J,LM) = 0. LLMH = LMH(I,J) Q2(I,J,LLMH-2)= HBM2(I,J)*Q2INI Q2(I,J,LLMH-1)= HBM2(I,J)*Q2INI ENDDO ENDDO C C PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL. C INITIALIZE LATENT HEATING ACCUMULATION ARRAYS. C DO L=1,LM DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) IF(Q(I,J,L).LT.EPSQ)Q(I,J,L)=EPSQ*HTM(I,J,L) TRAIN(I,J,L)=0. TCUCN(I,J,L)=0. ENDDO ENDDO ENDDO C C END OF SCRATCH START INITIALIZATION BLOCK. C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: INITIALIZED ARRAYS FOR CLEAN START' ENDIF ENDIF C C C C RESTART INITIALIZING. CHECK TO SEE IF WE NEED TO ZERO C ACCUMULATION ARRAYS. C IF(RESTRT)THEN C C AVERAGE CLOUD AMOUNT ARRAY C IF(MOD(NTSD,NCLOD).LT.NPHS)THEN IF(MYPE.EQ.0)WRITE(LIST,*)' ZERO AVG CLD AMT ARRAY' DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ACFRCV(I,J)=0. NCFRCV(I,J)=0 ACFRST(I,J)=0. NCFRST(I,J)=0 ENDDO ENDDO ENDIF C C GRID-SCALE AND CONVECTIVE LATENT HEATING ARRAYS. C IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN IF(MYPE.EQ.0)THEN WRITE(LIST,*)' ZERO ACCUM LATENT HEATING ARRAYS' ENDIF C AVRAIN=0. AVCNVC=0. DO L=1,LM DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) TRAIN(I,J,L)=0. TCUCN(I,J,L)=0. ENDDO ENDDO ENDDO ENDIF C*** C*** IF THIS IS NOT A NESTED RUN, INITIALIZE TKE C*** c IF(.NOT.NEST)THEN c DO L=1,LM c DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) c DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) c Q2(I,J,L)=AMAX1(Q2(I,J,L)*HBM2(I,J),EPSQ2) c ENDDO c ENDDO c ENDDO c ENDIF C C TOTAL AND CONVECTIVE PRECIPITATION ARRAYS. C TOTAL SNOW AND SNOW MELT ARRAYS. C STORM SURFACE AND BASE GROUND RUN OFF ARRAYS. C IF(MOD(NTSD,NPREC).LT.NPHS)THEN IF(MYPE.EQ.0)WRITE(LIST,*)' ZERO ACCUM PRECIP ARRAYS' DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ACPREC(I,J)=0. CUPREC(I,J)=0. VAPINC(I,J)=0. VAPINC7(I,J)=0. CLDINC(I,J)=0. CLDINC7(I,J)=0. ACSNOW(I,J)=0. ACSNOM(I,J)=0. SSROFF(I,J)=0. BGROFF(I,J)=0. C FQNEV(I,J)=0. !dule FQSEV(I,J)=0. !dule FCNEV(I,J)=0. !dule FCSEV(I,J)=0. !dule FCNEV7(I,J)=0. !dule FCSEV7(I,J)=0. !dule FQNEV7(I,J)=0. !dule FQSEV7(I,J)=0. !dule FQU(I,J)=0. !dule FQV(I,J)=0. !dule FCU(I,J)=0. !dule FCV(I,J)=0. !dule FQU7(I,J)=0. !dule FQV7(I,J)=0. !dule FCU7(I,J)=0. !dule FCV7(I,J)=0. !dule DQADV(I,J)=0. !dule DQFLX(I,J)=0. !dule DCFLX(I,J)=0. !dule DQFLX7(I,J)=0. !dule DCFLX7(I,J)=0. !dule DO L=1,LM !dule QOLD(I,J,L)=Q(I,J,L) !dule END DO !dule C ENDDO ENDDO ENDIF C C LONG WAVE RADIATION ARRAYS. C IF(MOD(NTSD,NRDLW).LT.NPHS)THEN IF(MYPE.EQ.0)WRITE(LIST,*)' ZERO ACCUM LW RADTN ARRAYS' ARDLW=0. DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ALWIN(I,J) =0. ALWOUT(I,J)=0. ALWTOA(I,J)=0. ENDDO ENDDO ENDIF C C SHORT WAVE RADIATION ARRAYS. C IF(MOD(NTSD,NRDSW).LT.NPHS)THEN IF(MYPE.EQ.0)WRITE(LIST,*)' ZERO ACCUM SW RADTN ARRAYS' ARDSW=0. DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ASWIN(I,J) =0. ASWOUT(I,J)=0. ASWTOA(I,J)=0. ENDDO ENDDO ENDIF C C SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS. C IF(MOD(NTSD,NSRFC).LT.NPHS)THEN IF(MYPE.EQ.0)WRITE(LIST,*)' ZERO ACCUM SFC FLUX ARRAYS' ASRFC=0. DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) SFCSHX(I,J)=0. SFCLHX(I,J)=0. SUBSHX(I,J)=0. SNOPCX(I,J)=0. SFCUVX(I,J)=0. SFCEVP(I,J)=0. POTEVP(I,J)=0. POTFLX(I,J)=0. ENDDO ENDDO ENDIF C C ENDIF FOR RESTART FILE ACCUMULATION ZERO BLOCK. C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: INITIALIZED ARRAYS FOR RESTART START' ENDIF ENDIF C----------------------------------------------------------------------- C----------------------------------------------------------------------- C C INITIALIZE CLOUD CONSTANTS C C----------------------------------------------------------------------- DO 350 J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO 350 I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) U00(I,J)=(1.-SM(I,J))*0.75+SM(I,J)*0.80 350 CONTINUE ! !--- Flag for initializing convective cloud arrays for radiation ! CURAD=.FALSE. C DO 355 L=1,2*LM IF(L.GE.LM-10.AND.L.LE.LM)THEN UL(L)=0.1*FLOAT(L-LM+10) ELSE UL(L)=0. ENDIF 355 CONTINUE C C----------------- INITIALIZE T0, Q0 & P0 FOR GSCOND ------------------- C IF(NSTART.EQ.0)THEN DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) P0(I,J)=PD(I,J) ENDDO ENDDO C DO L=1,LM DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) T0(I,J,L)=T(I,J,L) Q0(I,J,L)=Q(I,J,L) ENDDO ENDDO ENDDO ENDIF C*** C*** SET INDEX ARRAYS FOR UPSTREAM ADVECTION C*** KNT=0 DO J=3,5 KNT=KNT+1 IHLA(KNT)=2 IHHA(KNT)=IM-1-MOD(J+1,2) IVLA(KNT)=2 IVHA(KNT)=IM-1-MOD(J,2) JRA(KNT)=J ENDDO DO J=JM-4,JM-2 KNT=KNT+1 IHLA(KNT)=2 IHHA(KNT)=IM-1-MOD(J+1,2) IVLA(KNT)=2 IVHA(KNT)=IM-1-MOD(J,2) JRA(KNT)=J ENDDO DO J=6,JM-5 KNT=KNT+1 IHLA(KNT)=2 IHHA(KNT)=2+MOD(J,2) IVLA(KNT)=2 IVHA(KNT)=2+MOD(J+1,2) JRA(KNT)=J ENDDO DO J=6,JM-5 KNT=KNT+1 IHLA(KNT)=IM-2 IHHA(KNT)=IM-2+MOD(J,2) IVLA(KNT)=IM-2 IVHA(KNT)=IM-2+MOD(J+1,2) JRA(KNT)=J ENDDO C C*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS C IF(NSTART.EQ.0)THEN C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) PCTSNO(I,J)=-999.0 IF(SM(I,J).LT.0.5)THEN IF(SICE(I,J).GT.0.5)THEN C C*** SEA-ICE CASE C SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 SSROFF(I,J)=0.0 BGROFF(I,J)=0.0 CMC(I,J)=0.0 DO NS=1,NSOIL SMC(I,J,NS)=1.0 SH2O(I,J,NS)=1.0 ENDDO ENDIF ELSE C C*** WATER CASE C SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 SSROFF(I,J)=0.0 BGROFF(I,J)=0.0 SOILTB(I,J)=280.99 GRNFLX(I,J)=0. SUBSHX(I,J)=0.0 ACSNOW(I,J)=0.0 ACSNOM(I,J)=0.0 SNOPCX(I,J)=0.0 CMC(I,J)=0.0 SNO(I,J)=0.0 DO NS=1,NSOIL SMC(I,J,NS)=1.0 SH2O(I,J,NS)=1.0 STC(I,J,NS)=273.16 ENDDO ENDIF C ENDDO ENDDO C APHTIM=0.0 ARATIM=0.0 ACUTIM=0.0 C ENDIF C C------------------------------------------------------------------- C INITIALIZE RADTN VARIABLES C CALCULATE THE NUMBER OF STEPS AT EACH POINT. C THE ARRAY 'LVL' WILL COORDINATE VERTICAL LOCATIONS BETWEEN C THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS. C LVL HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT C EACH GRID POINT. C------------------------------------------------------------------- C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) LVL(I,J)=LM-LMH(I,J) ENDDO ENDDO C C DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2), C AND LOW(1) CLOUDS. ALSO FIND MODEL LAYER THAT IS JUST BELOW C (HEIGHT-WISE) 400 MB. (K400) C K400=0 PSUM=PT SLPM=101325. PDIF=SLPM-PT DO L=1,LM PSUM=PSUM+DETA(L)*PDIF IF(LTOP(3).EQ.0)THEN IF(PSUM.GT.PHITP)LTOP(3)=L ELSEIF(LTOP(2).EQ.0)THEN IF(PSUM.GT.PMDHI)LTOP(2)=L ELSEIF(K400.EQ.0)THEN IF(PSUM.GT.P400)K400=L ELSEIF(LTOP(1).EQ.0)THEN IF(PSUM.GT.PLOMD)LTOP(1)=L ENDIF ENDDO C C CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA C KCCO2=0 C C CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE C PSS=101325. PDIF=PSS-PT C DO L=1,LM1 PHALF(L+1)=AETA(L)*PDIF+PT ENDDO C PHALF(1)=0. PHALF(LP1)=PSS C CALL GRADFS(PHALF,KCCO2,NFILE) C C CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE C IF(MYPE.EQ.0)CALL SOLARD(RAD1) CALL MPI_BCAST(RAD1,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) C C CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR C THE SETUP OF THE OZONE DATA C TIME=(NTSD-1)*DT CALL ZENITH(TIME,DAYI,HOUR) ADDL=0. IF(MOD(IDAT(3),4).EQ.0)ADDL=1. RANG=PI2*(DAYI-RLAG)/(365.25+ADDL) RSIN1=SIN(RANG) RCOS1=COS(RANG) RCOS2=COS(2.*RANG) CALL O3CLIM C C------------------------------------------------------------------- C*** SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME C------------------------------------------------------------------- C DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) C C TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES C PDSL(I,J)=PD(I,J)*RES(I,J) LMHK=LMH(I,J) LMVK=LMV(I,J) ULM=U(I,J,LMVK) VLM=V(I,J,LMVK) TLM=T(I,J,LMHK) QLM=Q(I,J,LMHK) PLM=PDSL(I,J)*AETA(LMHK)+PT APELM=(1.0E5/PLM)**CAPA APELMNW=(1.0E5/PSHLTR(I,J))**CAPA EXNERR=(PSHLTR(I,J)*1.E-5)**CAPA THLM=TLM*APELM DPLM=PDSL(I,J)*DETA(LMHK)*0.5 DZLM=287.04*DPLM*TLM*(1.+0.608*QLM)/(9.801*PLM) FAC1=30./DZLM FAC2=(DZLM-30.)/DZLM IF(DZLM.LE.30.)THEN FAC1=1. FAC2=0. ENDIF C IF(.NOT.RESTRT)THEN TH30(I,J)=FAC2*THS(I,J)+FAC1*THLM Q30(I,J)=FAC2*QS(I,J)+FAC1*QLM U30(I,J)=ULM V30(I,J)=VLM ENDIF C FAC1=10./DZLM FAC2=(DZLM-10.)/DZLM IF(DZLM.LE.10.)THEN FAC1=1. FAC2=0. ENDIF C IF(.NOT.RESTRT)THEN TH10(I,J)=FAC2*THS(I,J)+FAC1*THLM Q10(I,J)=FAC2*QS(I,J)+FAC1*QLM U10(I,J)=ULM V10(I,J)=VLM ENDIF C FAC1=2./DZLM FAC2=(DZLM-2.)/DZLM IF(DZLM.LE.2.)THEN FAC1=1. FAC2=0. ENDIF C IF(.NOT.RESTRT.OR.NEST)THEN TSHLTR(I,J)=(FAC2*THS(I,J)+FAC1*THLM) QSHLTR(I,J)=FAC2*QS(I,J)+FAC1*QLM ENDIF C*** C*** NEED TO CONVERT TO THETA IF IS THE RESTART CASE C*** AS CHKOUT.f WILL CONVERT TO TEMPERATURE C*** IF(RESTRT)THEN TSHLTR(I,J)=TSHLTR(I,J)*APELMNW ENDIF ENDDO ENDDO C C-------------------------------------------------------------------- C END OF SUBROUTINE INIT. C------------------------------------------------------------------- C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: EXIT INIT AND START MODEL INTEGRATION' WRITE(LIST,*)' ' ENDIF C RETURN END C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& BLOCK DATA CLOUD INCLUDE "parmeta" C----------------------------------------------------------------------- C O M M O N /RD1TIM/ 1 K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1 2,LVL(IDIM1:IDIM2,JDIM1:JDIM2) C----------------------------------------------------------------------- D A T A 1 CTHK/20000.0,20000.0,20000.0/ 1,TAUCV/0.16, 0.14, 0.12/, LTOP/0,0,0/ C----------------------------------------------------------------------- END BLOCK DATA CLOUD