SUBROUTINE INIT !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: INIT INITIALIZE VARIABLE FOR MODEL RUN ! PRGRMMR: JANJIC ORG: W/NP22 DATE: ??-??-?? ! ABSTRACT: INIT READS IN PRIMARY AND AUXILIARY VARIABLES AND CONSTANTS ! AND SETS INITIAL VALUES FOR OTHERS ! PROGRAM HISTORY LOG: ! 87-06-?? JANJIC - ! 92-10-27 DEAVEN - CHANGED READS OF NHB, NFC, AND NBC TO ! ACCOMODATE SHORTENED RECORD LENGTHS ! 95-03-27 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL ! 96-10-31 BLACK - ADDED NAMELIST BCEXDATA FOR THE NESTS ! 98-06-10 ROGERS - MADE Y2K COMPLIANT BY REPLACING CALL TO W3FI13 ! TO W3DOXDAT ! 98-09-04 PYLE - CHANGED TO NOT RE-INITIALIZE TSHLTR AND QSHLTR IF ! RESTART=TRUE ! 98-10-21 BLACK - CHANGES FOR DISTRIBUTED MEMORY ! 98-11-17 BLACK - ADDED CODE TO LOCATE THE INNER DOMAIN BOUNDARIES ! ON THE RELEVANT PEs ! 00-08-?? BLACK - MODIFIED FOR RESTART CAPABILITY ! USAGE: CALL INIT FROM MAIN PROGRAM EBU ! INPUT ARGUMENT LIST: ! NONE ! OUTPUT ARGUMENT LIST: ! NONE ! INPUT FILES: ! NFC - THE INITIAL VALUES OF SFC PRESSURE, T, Q, U, AND V ! NHB - A LARGE VARIETY OF ARRAY AND SCALAR CONSTANTS ! NBC - THE BOUNDARY CONDITIONS AND TENDENCIES ! OR ! RESTRT - A RESTART FILE WITH ALL NECESSARY QUANTITIES ! OUTPUT FILES: ! NONE ! SUBPROGRAMS CALLED: ! UNIQUE: READ_NHB ! READ_RESTRT ! ZERO2 ! ZERO3 ! UTILITIES: W3LIB - W3DOXDAT ! NONE ! LIBRARY: ! COMMON - CTLBLK ! LOOPS ! MASKS ! DYNAM ! PHYS2 ! MAPOT1 ! VRBLS ! PVRBLS ! NHYDRO ! BOCO ! GRIDS ! ACMCLH ! ACMCLD ! ACMPRE ! ACMRDL ! ACMRDS ! ACMSFC ! CLDWTR ! C_Tadj ! CNVCLD ! SOIL ! INDX ! TEMPV ! RD1TIM ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ !----------------------------------------------------------------------- ! INCLUDE/SET PARAMETERS. !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "parm.tbl.f90" INCLUDE "cuparm.f90" INCLUDE "parmsoil.f90" INCLUDE "mpp.h" INCLUDE "mpif.h" #include "sp.h" !----------------------------------------------------------------------- PARAMETER & (CM1=2937.4,CM2=4.9283,CM3=23.5518,EPS=0.622,PI2=2.*3.14159265 & , RLAG=14.8125 & ! VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV ! &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 ! &, Q2INI=1.0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 ! &, Q2INI=.50,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 ! &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=0.0 , Q2INI=.50 ,EPSQ2=0.2 ,EPSWET=0.0 & ! AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA , Z0LAND=.10,Z0SEA=.001,FCM=.00001 & , DTR=0.1745329E-1) !----------------------------------------------------------------------- PARAMETER & (A1=610.78,WA=.10,WG=1.0-WA) !----------------------------------------------------------------------- PARAMETER & (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) !----------------------------------------------------------------------- ! DECLARE VARIABLES !----------------------------------------------------------------------- LOGICAL :: & RUN,RUNB,FIRST,RESTRT,SIGMA,EXBC,NEST & ,INSIDEH,INSIDEV !----------------------------------------------------------------------- CHARACTER(32) :: & LABEL CHARACTER(40) :: & CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV & ,FILCLD,FILRAD,FILSFC !----------------------------------------------------------------------- REAL :: & PHALF(LP1),NPEBND !*** !*** NOTE: THE DIMENSION OF THE FOLLOWING ARRAYS IS ARBITRARILY CHOSEN !*** TO EXCEED ANY NUMBER OF BOUNDARY POINTS THAT MIGHT EXIST IN !*** ANY INNER DOMAIN !*** REAL :: & HLATI(1500),HLONI(1500),VLATI(1500),VLONI(1500) & ,THLONI(1500),THLATI(1500),TVLONI(1500),TVLATI(1500) & ,TSLAT(NSTAT),TSLON(NSTAT) !----------------------------------------------------------------------- INTEGER :: & IDATB(3),INIDAT(8),IBCDAT(8) !----------------------------------------------------------------------- #ifdef DP_REAL LOGICAL*8 RUNBX INTEGER*8 :: IDATBX(3),IHRSTBX #endif !----------------------------------------------------------------------- ! INCLUDE COMMON BLOCKS. INCLUDE "COMM_CTLBLK.f90" INCLUDE "COMM_LOOPS.f90" INCLUDE "COMM_MASKS.f90" INCLUDE "COMM_DYNAM.f90" INCLUDE "COMM_PHYS2.f90" INCLUDE "COMM_MAPOT1.f90" INCLUDE "COMM_VRBLS.f90" INCLUDE "COMM_CONTIN.f90" INCLUDE "COMM_NHYDRO.f90" INCLUDE "COMM_PVRBLS.f90" INCLUDE "COMM_BOCO.f90" INCLUDE "COMM_ACMCLH.f90" INCLUDE "COMM_ACMCLD.f90" INCLUDE "COMM_ACMPRE.f90" INCLUDE "COMM_ACMRDL.f90" INCLUDE "COMM_ACMRDS.f90" INCLUDE "COMM_ACMSFC.f90" INCLUDE "COMM_CLDWTR.f90" INCLUDE "COMM_C_Tadj.f90" INCLUDE "COMM_CNVCLD.f90" INCLUDE "COMM_SOIL.f90" INCLUDE "COMM_INDX.f90" INCLUDE "COMM_Z0EFFT.f90" INCLUDE "COMM_PPTASM.f90" INCLUDE "COMM_TEMPV.f90" !----------------------------------------------------------------------- !*** !*** THE FOLLOWING IS FOR TIMIMG PURPOSES ONLY !*** real*8 :: timef real :: nhb_tim common/timing/surfce_tim,nhb_tim,res_tim,exch_tim !----------------------------------------------------------------------- COMMON /RD1TIM/ & K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1 & ,LVL(IDIM1:IDIM2,JDIM1:JDIM2) !----------------------------------------------------------------------- DATA & PLOMD/64200./,PMDHI/35000./,PHITP/15000./,P400/40000./ & ,PLBTM/105000./ DATA & NFILE/14/,IUNWGT/40/ !--- Flag for initializing microphysical statistics COMMON /CMICRO_START/ MICRO_START LOGICAL :: MICRO_START !----------------------------------------------------------------------- !--- Flag for initializing convective clouds for radiation COMMON /CUINIT/ CURAD LOGICAL :: CURAD !----------------------------------------------------------------------- ! DECLARE NAMELISTS. NAMELIST /FCSTDATA/ & TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL & ,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP & ,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC & ,NEST,HYDRO,SPLINE !*********************************************************************** ! START INIT HERE. ! CALCULATE THE I-INDEX EAST-WEST INCREMENTS 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 ! CALCULATE THE INDIRECT I INDICES FOR RADTN 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 ! ZERO OUT LOCALLY INDEXED ARRAYS 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) !--------------------------------------------------------------- ! READ Z0 EFFECTIVE ! xpl open(unit=22,file='ZEFF',form='unformatted') ! xpl DO N=1,4 IF(MYPE == 0)THEN READ(22)TEMP1 ENDIF CALL DSTRB(TEMP1,ZEFFIJ,1,4,N) ENDDO !--------------------------------------------------------------- !*** !*** READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB !*** NHB=12 LSL =LSM btim=timef() CALL READ_NHB(NHB) nhb_tim=timef()-btim !--------------------------------------------------------------- NHIBU = 12 IF(MYPE == 0)WRITE(LIST,*)'INIT: READ CONSTANTS FILE' ! READ NAMELIST FCSTDATA WHICH CONTROLS TIMESTEPS, ! ACCUMULATION PERIODS, STANDARD OUTPUT RESTRT = .FALSE. LFCSTD=11 open(LFCSTD,file='fcstdata.meso',status='old') REWIND LFCSTD READ(LFCSTD,FCSTDATA) if (MYPE == 0) then write(6,*) 'HYDRO=' , HYDRO write(6,*) 'SPLINE=' , SPLINE endif IF(MYPE == 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,*)' HYDRO : ',HYDRO 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,NMAP) 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 ! SET TIME STEPPING RELATED CONSTANTS. 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 == 0)THEN WRITE(0,*)' NTSTM=',NTSTM,' TSPH=',TSPH,' DT=',DT ENDIF ! IF (NSTART.LT.NCP) NSTART=0 ! SET VARIOUS PHYSICS PACKAGE TIMESTEP VARIABLES. 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) IF(MYPE == 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 ! 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 !*** !*** SET UP ARRAY IRAD (INDICES FOR RADTN) !*** DO I=MYIS,MYIE IRAD(I)=IRADG(I+MY_IS_GLB-1)-MY_IS_GLB+1 ENDDO !------------------------------------------------------------- !*** !*** READ INITIAL CONDITIONS OR RESTART FILE. !*** btim=timef() IF(SINGLRST)THEN CALL READ_RESTRT ELSE CALL READ_RESTRT2 ENDIF res_tim=timef()-btim !------------------------------------------------------------- ! IF NOT RUNNING THE MODEL, PRINT DATE OF INITIAL CONDITIONS ! JUST READ AND STOP. OTHERWISE, CONTINUE. !------------------------------------------------------------- IF (RUN) GO TO 190 IF(MYPE == 0)THEN WRITE(LIST,165) IHRST,IDAT WRITE(LIST,166) ! ccc 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 ! IF THE TIMESTEP COUNTER (NTSD) EXCEEDS THE "STOP MODEL" T ! TIMESTEP,CONTINUE, STOP EXECUTION. OTHERWISE, CONTINUE. 190 IF(NTSD >= NTSTM)THEN IF(MYPE == 0)THEN WRITE(LIST,165) IHRST,IDAT WRITE(LIST,195) 195 FORMAT('0F*** FORECAST ALREADY DONE. RUN TERMINATED.') ! ccc CALL EXIT(3) CALL MPI_FINALIZE(IERR) STOP3 ENDIF ENDIF !------------------------------------------------------------- ! READ BOUNDARY CONDITIONS. !------------------------------------------------------------- IF(MYPE == 0)THEN ! ench open(unit=NBC,form='unformatted', & file='bndy.file') ! ench 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 IF( .NOT. NEST)REWIND NBC #ifdef DP_REAL IF(NEST)THEN READ(NBC,REC=1)RUNBX,IDATBX,IHRSTBX,TBOCO ELSE READ(NBC)RUNBX,IDATBX,IHRSTBX,TBOCO ENDIF RUNB=RUNBX IDATB=IDATBX IHRSTB=IHRSTBX #else IF(NEST)THEN READ(NBC,REC=1)RUNB,IDATB,IHRSTB,TBOCO ELSE write(6,*) 'reading from NBC here' READ(NBC)RUNB,IDATB,IHRSTB,TBOCO write(6,*) 'past from NBC here' write(6,*) 'IDATB: ', IDATB write(6,*) 'IHRSTB: ', IHRSTB ENDIF #endif ENDIF 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) CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) IF(MYPE == 0 .AND. .NOT. NEST)THEN ISTART=NINT(TSTART) READ(NBC)BCHR 205 READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) READ(NBC) IF(ISTART == NINT(BCHR))THEN IF(ISTART > 0)READ(NBC)BCHR GO TO 215 ELSE READ(NBC)BCHR ENDIF IF(ISTART >= NINT(BCHR))GO TO 205 ENDIF IF(MYPE == 0 .AND. NEST)THEN ISTART=NINT(TSTART) NREC=1 210 NREC=NREC+1 READ(NBC,REC=NREC)BCHR IF(ISTART == NINT(BCHR))THEN IF(ISTART > 0)READ(NBC,REC=NREC+1)BCHR GO TO 215 ELSE GO TO 210 ENDIF ENDIF 215 CONTINUE CALL MPI_BCAST(BCHR,1,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) IF(MYPE == 0)WRITE(LIST,*)' READ UNIT NBC=',NBC !*** !*** COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ !*** NBOCO=NINT(BCHR*TSPH) IF(NTSD == 0)THEN IF(MYPE == 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 !------------------------------------------------------------- ! SET ARRAYS CONTROLLING POST PROCESSING. !------------------------------------------------------------- IF(MYPE == 0)THEN WRITE(LIST,*)'INIT: READ IOUT,NSHDE,NTSD=',IOUT,NSHDE,NTSD ENDIF DO I=1,NMAP IOUT=I IF(ISHDE(I) >= NTSD)GO TO 220 ENDDO 220 NSHDE = ISHDE(IOUT) IF(MYPE == 0)THEN WRITE(LIST,*)'INIT: SET IOUT,NSHDE =',IOUT,NSHDE, & ' FOR ISHDE,NTSD=',ISHDE(IOUT),NTSD ENDIF !------------------------------------------------------------- ! INITIALIZE PHYSICS VARIABLES IF STARTING THIS RUN FROM SCRATCH. IF(NEST)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) IF(T(I,J,LLMH) == 0.)THEN T(I,J,LLMH)=T(I,J,LLMH-1) ENDIF TERM1=-0.068283/T(I,J,LLMH) PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1) ENDDO ENDDO ENDIF 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. Z0(I,J) = SM(I,J)*Z0SEA+(1.-SM(I,J))* & (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. !*** !*** AT THIS POINT, WE MUST CALCULATE THE INITIAL POTENTIAL TEMPERATURE !*** OF THE SURFACE AND OF THE SUBGROUND. !*** EXTRAPOLATE DOWN FOR INITIAL SURFACE POTENTIAL TEMPERATURE. !*** ALSO DO THE SHELTER PRESSURE. !*** 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 IF(SM(I,J) < 0.5) THEN QS(I,J)=PQ0/PSFCK*EXP(A2*(TSFCK-A3)/(TSFCK-A4)) ELSEIF(SM(I,J) > 0.5) THEN THS(I,J)=SST(I,J)*(1.E5/(PD(I,J)+PT))**CAPA ENDIF TERM1=-0.068283/T(I,J,LLMH) PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1) 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. ENDDO ENDDO ! INITIALIZE CLOUD FIELDS 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 ! INITIALIZE ACCUMULATOR ARRAYS TO ZERO. ARDSW=0.0 ARDLW=0.0 ASRFC=0.0 AVRAIN=0.0 AVCNVC=0.0 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 ! INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER. DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) IF(SM(I,J) > 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 ! PAD GROUND WETNESS IF IT IS TOO SMALL. ! DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) ! DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ! WET(I,J)=AMAX1(WET(I,J),EPSWET) ! ENDDO ! ENDDO ! INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL ! VALUE (EPSQ2) ABOVE GROUND. SET TKE TO ZERO IN THE ! THE LOWEST MODEL LAYER. IN THE LOWEST TWO ATMOSPHERIC ! ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI). 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 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 ! PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL. ! INITIALIZE LATENT HEATING ACCUMULATION ARRAYS. 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) < EPSQ)Q(I,J,L)=EPSQ*HTM(I,J,L) TRAIN(I,J,L)=0. TCUCN(I,J,L)=0. ENDDO ENDDO ENDDO ! END OF SCRATCH START INITIALIZATION BLOCK. IF(MYPE == 0)THEN WRITE(LIST,*)'INIT: INITIALIZED ARRAYS FOR CLEAN START' ENDIF ENDIF ! RESTART INITIALIZING. CHECK TO SEE IF WE NEED TO ZERO ! ACCUMULATION ARRAYS. IF(RESTRT)THEN ! AVERAGE CLOUD AMOUNT ARRAY IF (NSTART == 0) THEN ! IF(MOD(NTSD,NCLOD).LT.NPHS)THEN IF(MYPE == 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 ! GRID-SCALE AND CONVECTIVE LATENT HEATING ARRAYS. IF (NSTART == 0) THEN ! IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN IF(MYPE == 0)THEN WRITE(LIST,*)' ZERO ACCUM LATENT HEATING ARRAYS' ENDIF 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 !*** !*** IF THIS IS NOT A NESTED RUN, INITIALIZE TKE !*** ! IF(.NOT.NEST)THEN ! DO L=1,LM ! DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) ! DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ! Q2(I,J,L)=AMAX1(Q2(I,J,L)*HBM2(I,J),EPSQ2) ! ENDDO ! ENDDO ! ENDDO ! ENDIF ! TOTAL AND CONVECTIVE PRECIPITATION ARRAYS. ! TOTAL SNOW AND SNOW MELT ARRAYS. ! STORM SURFACE AND BASE GROUND RUN OFF ARRAYS. IF (NSTART == 0) THEN ! IF(MOD(NTSD,NPREC).LT.NPHS)THEN IF(MYPE == 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. ACSNOW(I,J)=0. ACSNOM(I,J)=0. SSROFF(I,J)=0. BGROFF(I,J)=0. ENDDO ENDDO ENDIF ! LONG WAVE RADIATION ARRAYS. IF (NSTART == 0) THEN ! IF(MOD(NTSD,NRDLW).LT.NPHS)THEN IF(MYPE == 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 ! SHORT WAVE RADIATION ARRAYS. IF (NSTART == 0) THEN ! IF(MOD(NTSD,NRDSW).LT.NPHS)THEN IF(MYPE == 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 ! SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS. IF (NSTART == 0) THEN ! IF(MOD(NTSD,NSRFC).LT.NPHS)THEN IF(MYPE == 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 ! ENDIF FOR RESTART FILE ACCUMULATION ZERO BLOCK. IF(MYPE == 0)THEN WRITE(LIST,*)'INIT: INITIALIZED ARRAYS FOR RESTART START' ENDIF ENDIF !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! INITIALIZE CLOUD CONSTANTS !----------------------------------------------------------------------- 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 U00(I,J)=.95 350 END DO !--- Flag for Initializing arrays, lookup tables, & constants used in ! microphysics and radiation MICRO_START= .TRUE. !--- Flag for initializing convective cloud arrays for radiation CURAD= .FALSE. DO 355 L=1,2*LM IF(L >= LM-10 .AND. L <= LM)THEN UL(L)=0.1*FLOAT(L-LM+10) ELSE UL(L)=0. ENDIF 355 END DO !*** !*** SET INDEX ARRAYS FOR UPSTREAM ADVECTION !*** 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 !*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS IF(NSTART == 0)THEN 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) < 0.5)THEN IF(SICE(I,J) > 0.5)THEN !*** SEA-ICE CASE 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 !*** WATER CASE SMSTAV(I,J)=1.0 SMSTOT(I,J)=1.0 SSROFF(I,J)=0.0 BGROFF(I,J)=0.0 SOILTB(I,J)=273.16 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 ENDDO ENDDO APHTIM=0.0 ARATIM=0.0 ACUTIM=0.0 ENDIF !------------------------------------------------------------------- ! INITIALIZE RADTN VARIABLES ! CALCULATE THE NUMBER OF STEPS AT EACH POINT. ! THE ARRAY 'LVL' WILL COORDINATE VERTICAL LOCATIONS BETWEEN ! THE LIFTED WORKING ARRAYS AND THE FUNDAMENTAL MODEL ARRAYS. ! LVL HOLDS THE HEIGHT (IN MODEL LAYERS) OF THE TOPOGRAPHY AT ! EACH GRID POINT. !------------------------------------------------------------------- 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 ! DETERMINE MODEL LAYER LIMITS FOR HIGH(3), MIDDLE(2), ! AND LOW(1) CLOUDS. ALSO FIND MODEL LAYER THAT IS JUST BELOW ! (HEIGHT-WISE) 400 MB. (K400) K400=0 PSUM=PT SLPM=101325. PDIF=SLPM-PT DO L=1,LM PSUM=PSUM+DETA(L)*PDIF IF(LTOP(3) == 0)THEN IF(PSUM > PHITP)LTOP(3)=L ELSEIF(LTOP(2) == 0)THEN IF(PSUM > PMDHI)LTOP(2)=L ELSEIF(K400 == 0)THEN IF(PSUM > P400)K400=L ELSEIF(LTOP(1) == 0)THEN IF(PSUM > PLOMD)LTOP(1)=L ENDIF ENDDO ! CALL GRADFS ONCE TO CALC. CONSTANTS AND GET O3 DATA KCCO2=0 ! CALCULATE THE MIDLAYER PRESSURES IN THE STANDARD ATMOSPHERE PSS=101325. PDIF=PSS-PT DO L=1,LM1 PHALF(L+1)=AETA(L)*PDIF+PT ENDDO PHALF(1)=0. PHALF(LP1)=PSS CALL GRADFS(PHALF,KCCO2,NFILE) ! CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE IF(MYPE == 0)CALL SOLARD(RAD1) CALL MPI_BCAST(RAD1,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) ! CALL ZENITH SIMPLY TO GET THE DAY OF THE YEAR FOR ! THE SETUP OF THE OZONE DATA TIME=(NTSD-1)*DT CALL ZENITH(TIME,DAYI,HOUR) ADDL=0. IF(MOD(IDAT(3),4) == 0)ADDL=1. RANG=PI2*(DAYI-RLAG)/(365.25+ADDL) RSIN1=SIN(RANG) RCOS1=COS(RANG) RCOS2=COS(2.*RANG) CALL O3CLIM !------------------------------------------------------------------- !*** SOME INITIAL VALUES RELATED TO TURBULENCE SCHEME !------------------------------------------------------------------- DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) ! TRY A SIMPLE LINEAR INTERP TO GET 2/10 M VALUES 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=10./DZLM FAC2=(DZLM-10.)/DZLM IF(DZLM <= 10.)THEN FAC1=1. FAC2=0. ENDIF 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 FAC1=2./DZLM FAC2=(DZLM-2.)/DZLM IF(DZLM <= 2.)THEN FAC1=1. FAC2=0. ENDIF IF( .NOT. RESTRT .OR. NEST)THEN ! TSHLTR(I,J)=FAC2*THS(I,J)+FAC1*THLM TSHLTR(I,J)=0.1*THS(I,J)+0.9*THLM ! QSHLTR(I,J)=FAC2*QS(I,J)+FAC1*QLM QSHLTR(I,J)=QLM ENDIF ! SM V100m FAC1=100./DZLM FAC2=(DZLM-100.)/DZLM IF(DZLM <= 100.)THEN FAC1=1. FAC2=0. ENDIF IF( .NOT. RESTRT)THEN TH100(I,J)=FAC2*THS(I,J)+FAC1*THLM Q100(I,J)=FAC2*QS(I,J)+FAC1*QLM U100(I,J)=ULM V100(I,J)=VLM ENDIF ! SM V100m !*** !*** NEED TO CONVERT TO THETA IF IS THE RESTART CASE !*** AS CHKOUT.f WILL CONVERT TO TEMPERATURE !*** IF(RESTRT)THEN TSHLTR(I,J)=TSHLTR(I,J)*APELMNW ENDIF ENDDO ENDDO !------------------------------------------------------------------- !*** INITIALIZE NONHYDROSTATIC QUANTITIES !------------------------------------------------------------------- DO L=1,LM DO J=MYJS,MYJE DO I=MYIS,MYIE DWDT(I,J,L)=1. ENDDO ENDDO ENDDO !*** IF(SIGMA)THEN DO J=MYJS,MYJE DO I=MYIS,MYIE PDSL(I,J)=PD(I,J) ENDDO ENDDO ELSE DO J=MYJS,MYJE DO I=MYIS,MYIE PDSL(I,J)=RES(I,J)*PD(I,J) ENDDO ENDDO ENDIF !*** DO L=1,LP1 DO J=MYJS,MYJE DO I=MYIS,MYIE PINT(I,J,L)=PDSL(I,J)*ETA(L)+PT Z(I,J,L)=PINT(I,J,L) ENDDO ENDDO ENDDO !-------------------------------------------------------------------- ! END OF SUBROUTINE INIT. !------------------------------------------------------------------- IF(MYPE == 0)THEN WRITE(LIST,*)'INIT: EXIT INIT AND START MODEL INTEGRATION' WRITE(LIST,*)' ' ENDIF RETURN END SUBROUTINE INIT !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& BLOCK DATA CLOUD INCLUDE "parmeta.f90" !----------------------------------------------------------------------- COMMON /RD1TIM/ & K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1 & ,LVL(IDIM1:IDIM2,JDIM1:JDIM2) !----------------------------------------------------------------------- DATA & CTHK/20000.0,20000.0,20000.0/ & ,TAUCV/0.16, 0.14, 0.12/, LTOP/0,0,0/ !----------------------------------------------------------------------- END BLOCK DATA CLOUD