SUBROUTINE INITS 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 PEs C 00-08-?? BLACK - MODIFIED FOR RESTART CAPABILITY 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 SLOPES C DYNAM C PHYS2 C MAPOT1 C VRBLS C PVRBLS C NHYDRO C BOCO C GRIDS C ACMCLH C ACMCLD C ACMPRE C ACMRDL C ACMRDS C ACMSFC C CLDWTR C C_Tadj C CNVCLD 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 "EXCHM.h" 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 Cligia CHARACTER(LEN=4) cyr CHARACTER(LEN=2) cmon,cday,cutc Cligia 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----------------------------------------------------------------------- Cligia updt C INCLUDE COMMON BLOCKS. C INCLUDE "CTLBLK.comm" INCLUDE "LOOPS.comm" INCLUDE "MASKS.comm" INCLUDE "SLOPES.comm" INCLUDE "DYNAM.comm" INCLUDE "PHYS2.comm" INCLUDE "MAPOT1.comm" INCLUDE "VRBLS.comm" INCLUDE "CONTIN.comm" INCLUDE "NHYDRO.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 "C_Tadj.comm" INCLUDE "CNVCLD.comm" INCLUDE "SOIL.comm" INCLUDE "INDX.comm" INCLUDE "Z0EFFT.comm" INCLUDE "PPTASM.comm" INCLUDE "TEMPV.comm" INCLUDE "UPDT.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 microphysical statistics ! COMMON /CMICRO_START/ MICRO_START LOGICAL :: MICRO_START !----------------------------------------------------------------------- ! !--- 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,HYDRO,SPLINE 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 Cexpl open(unit=22,file='ZEFF',form='unformatted') Cexpl DO N=1,4 IF(MYPE.EQ.0)THEN READ(22)TEMP1 ENDIF CALL DSTRB(TEMP1,ZEFFIJ,1,4,N) ENDDO cligia c Read monthly veg greeness OPEN(unit=9,file='VGREEN_12mo.dat',form='unformatted') DO N=1,12 IF(MYPE.EQ.0)THEN READ(9)TEMP1 ENDIF CALL DSTRB(TEMP1,VEGFRM,1,12,N) ENDDO cligia C--------------------------------------------------------------- C*** C*** READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB C*** NHB=12 cligia NSST=47 cligia LSL =LSM btim=timef() CALL READ_NHB(NHB) cligia c READ SST MONTHLY DATA FROM UNIT NHB CALL READ_SST12M(NSST) sst=sstm(:,:,INITSST) IF(MYPE.EQ.0) write(6,*) 'init msst values' C START DE SST FIELD C READ SST12M DATA FROM UNIT CONNECTED TO NSST C READ CO2 ANNUALY DATA FROM UNIT NHB CALL READ_CO2(NSST) IF(MYPE.EQ.0) write(6,*) 'init co2 values' cligia 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. LFCSTD=11 open(LFCSTD,file='fcstdata.meso',status='old') REWIND LFCSTD READ(LFCSTD,FCSTDATA) if (MYPE .eq. 0) then write(6,*) 'HYDRO=' , HYDRO write(6,*) 'SPLINE=' , SPLINE endif 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,*)' 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 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) C cligia IF(MYPE.EQ.0)THEN cligia WRITE(0,*)' NTSTM=',NTSTM,' TSPH=',TSPH,' DT=',DT cligiq 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 cligia CALL READ_RESTRT cligia CALL READ_RESTRT(TSTART) cligia ELSE CALL READ_RESTRT2 ENDIF res_tim=timef()-btim 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) cligia CALL MPI_FINALIZE(IERR) cligia CALL MPI_FINALIZE(MPI_COMM_COMP,IERR) cligia 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) cligia CALL MPI_FINALIZE(IERR) cligia CALL MPI_FINALIZE(MPI_COMM_COMP,IERR) cligia STOP3 ENDIF ENDIF Cligia IF(MYPE.EQ.0)THEN WRITE(0,*)"JLG TESTE" WRITE(0,*)idat(3),idat(1),idat(2),ihrst WRITE(cyr,'(i4)')idat(3) WRITE(cmon,'(i2)')idat(1) IF (idat(1) .LT. 10) cmon(1:1)='0' WRITE(cday,'(i2)')idat(2) IF (idat(2) .LT. 10) cday(1:1)='0' WRITE(cutc,'(i2)')ihrst IF (ihrst .LT. 10) cutc(1:1)='0' WRITE(chardate,'(a4,3a2)')cyr,cmon,cday,cutc WRITE(0,*)chardate ENDIF cligia C------------------------------------------------------------- C C READ BOUNDARY CONDITIONS. C C------------------------------------------------------------- IF(MYPE.EQ.0)THEN Cbench open(unit=NBC,form='unformatted', + file='bndy.file') Cbench cligia IF(NEST)THEN cligia KBI=2*IM+JM-3 cligia KBI2=KBI-4 cligia LRECBC=4*(1+(1+6*LM)*KBI*2+(KBI+KBI2)*(LM+1)) cligia OPEN(UNIT=NBC,ACCESS='DIRECT',RECL=LRECBC) cligia ENDIF C cligia IF(.NOT.NEST)REWIND NBC C cligia REWIND NBC cligia #ifdef DP_REAL cligia IF(NEST)THEN cligia READ(NBC,REC=1)RUNBX,IDATBX,IHRSTBX,TBOCO cligia ELSE READ(NBC)RUNBX,IDATBX,IHRSTBX,TBOCO cligia ENDIF C RUNB=RUNBX IDATB=IDATBX IHRSTB=IHRSTBX #else cligia IF(NEST)THEN cligia READ(NBC,REC=1)RUNB,IDATB,IHRSTB,TBOCO cligia ELSE cligia write(6,*) 'reading from NBC here' READ(NBC)RUNB,IDATB,IHRSTB,TBOCO write(6,*) 'past from NBC here' cligia write(6,*) 'IDATB: ', IDATB cligia write(6,*) 'IHRSTB: ', IHRSTB cligia 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 cligia IF(MYPE.EQ.0.AND..NOT.NEST)THEN cligia ISTART=NINT(TSTART) C cligia READ(NBC)BCHR cligia 205 READ(NBC) cligia READ(NBC) cligia READ(NBC) cligia READ(NBC) cligia READ(NBC) cligia READ(NBC) cligia READ(NBC) C cligia IF(MYPE.EQ.0)THEN 205 READ(NBC)BCHR READ(NBC)PDB READ(NBC)TB READ(NBC)QB READ(NBC)UB READ(NBC)VB READ(NBC)Q2B READ(NBC)CWMB cligia cligia IF(ISTART.EQ.NINT(BCHR))THEN cligia IF(ISTART.GT.0)READ(NBC)BCHR cligia GO TO 215 cligia ELSE cligia READ(NBC)BCHR cligia ENDIF C cligia IF(ISTART.GE.NINT(BCHR))GO TO 205 cligia ENDIF C cligia IF(MYPE.EQ.0.AND.NEST)THEN cligia ISTART=NINT(TSTART) cligia NREC=1 C cligia 210 NREC=NREC+1 cligia READ(NBC,REC=NREC)BCHR C cligia IF(ISTART.EQ.NINT(BCHR))THEN cligia IF(ISTART.GT.0)READ(NBC,REC=NREC+1)BCHR cligia GO TO 215 cligia ELSE cligia GO TO 210 cligia ENDIF cligia ENDIF C cligia 215 CONTINUE C cligia IF(NINT(BCHR).LT.NINT(TSTART))GO TO 205 ENDIF cligia CALL MPI_BCAST(BCHR,1,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) cligia CALL MPI_BCAST(PDB(1,1),2*LB,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(TB(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(QB(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(UB(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VB(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(Q2B(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) CALL MPI_BCAST(CWMB(1,1,1),2*LB*LM,MPI_REAL,0, 1 MPI_COMM_COMP,IRTN) cligia 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*** cligia NBOCO=NINT(BCHR*TSPH) cligia NBOCO=INT(BCHR*TSPH+0.5) cligia cligia IF(NTSD.EQ.NBOCO)THEN cligia cligia IF(MYPE.EQ.0.AND..NOT.NEST)THEN cligia IF(MYPE.EQ.0)THEN cligia 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 c IF(NEST)THEN c DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) c DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) C c LLMH=LMH(I,J) C c IF(T(I,J,LLMH).EQ.0.)THEN c T(I,J,LLMH)=T(I,J,LLMH-1) c ENDIF C c TERM1=-0.068283/T(I,J,LLMH) c PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1) c ENDDO c ENDDO c 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. 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. cligia HTOP(I,J) = 100. cligia HBOT(I,J) = 0. cligia HTOP(I,J) = REAL(LLMH) HBOT(I,J) = REAL(LLMH) cligia 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 cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NCLOD).LT.NPHS)THEN cligia 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 cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN cligia 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 cligia c CLOUD EFFICIENCY DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE) DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE) CLDEFI(I,J)=AVGEFI*SM(I,J)+STEFI*(1.-SM(I,J)) ENDDO ENDDO cligia cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NPREC).LT.NPHS)THEN cligia 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. ACSNOW(I,J)=0. ACSNOM(I,J)=0. SSROFF(I,J)=0. BGROFF(I,J)=0. ENDDO ENDDO ENDIF C C LONG WAVE RADIATION ARRAYS. C cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NRDLW).LT.NPHS)THEN cligia 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 cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NRDSW).LT.NPHS)THEN cligia 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 cligia IF (NSTART .EQ. 0) THEN cligia IF(MOD(NTSD,NSRFC).LT.NPHS)THEN cligia 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 U00(I,J)=.95 350 CONTINUE ! !--- 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. 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 cligia C----------------- INITIALIZE T0, Q0 & P0 FOR GSCOND ------------------- C 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 cligia 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)=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 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=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 cligia IF(.NOT.RESTRT.OR.NEST)THEN ! TSHLTR(I,J)=FAC2*THS(I,J)+FAC1*THLM cligia TSHLTR(I,J)=0.1*THS(I,J)+0.9*THLM ! QSHLTR(I,J)=FAC2*QS(I,J)+FAC1*QLM cligia QSHLTR(I,J)=QLM cligia ENDIF cligia IF(.NOT.RESTRT)THEN TSHLTR(I,J)=FAC2*THS(I,J)+FAC1*THLM QSHLTR(I,J)=FAC2*QS(I,J)+FAC1*QLM ENDIF cligia CGSM V100m FAC1=100./DZLM FAC2=(DZLM-100.)/DZLM IF(DZLM.LE.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 CGSM V100m 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*** INITIALIZE NONHYDROSTATIC QUANTITIES C------------------------------------------------------------------- C DO L=1,LM C DO J=MYJS,MYJE DO I=MYIS,MYIE DWDT(I,J,L)=1. ENDDO ENDDO ENDDO C*** 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 C C*** C DO L=1,LP1 C 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 C C--------------SLOPE DIRECTION IDENTIFICATION LOOP---------------------- C CALL EXCH(ISLD,1,5,5) CALL EXCH(LMV,1,5,5) DO L=1,LM DO J=JDIM1,JDIM2 DO I=IDIM1,IDIM2 VTMS(I,J,L)=0 END DO END DO END DO DO J=JDIM1,JDIM2 DO I=IDIM1,IDIM2 IF (ISLD(I,J).GT.0) THEN VTMS(I,J,LMV(I,J)+1)=1 END IF END DO END DO 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&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& c BLOCK DATA CLOUD c INCLUDE "parmeta" C----------------------------------------------------------------------- c C O M M O N /RD1TIM/ c 1 K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1 c 2,LVL(IDIM1:IDIM2,JDIM1:JDIM2) C----------------------------------------------------------------------- C D A T A c 1 CTHK/20000.0,20000.0,20000.0/ c 1,TAUCV/0.16, 0.14, 0.12/, LTOP/0,0,0/ C----------------------------------------------------------------------- c END BLOCK DATA CLOUD