      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 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                  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 "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
CJLG     
      CHARACTER(LEN=4)  cyr
      CHARACTER(LEN=2)  cmon,cday,cutc
CJLG     
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 "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"
      INCLUDE "KFFDBK.comm"
						INCLUDE "KFLUT.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
Chou 20080202   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
Chou      
C---------------------------------------------------------------
C***
C***  READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB
C***
      NHB=12
      NSST=47
      LSL  =LSM
      btim=timef()
      CALL READ_NHB(NHB)
      nhb_tim=timef()-btim

CJFP  READ SST MONTHLY DATA FROM UNIT NHB
      CALL READ_SST12M(NSST)
      sst=sstm(:,:,INITSST)
      write(6,*) 'init msst values'
CJFP
CJFP  READ SST12M DATA FROM UNIT CONNECTED TO NSST      
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
      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-------------------------------------------------------------
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
CJLG
      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
CJLG      
C     
C-------------------------------------------------------------
C
C     READ BOUNDARY CONDITIONS.
C     
C-------------------------------------------------------------
      IF(MYPE.EQ.0)THEN
Cbench
        open(unit=NBC,form='unformatted',
     +          file='bndy.file')
Cbench

        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
	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
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.
          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.
          HTOP(I,J)   = REAL(LLMH)   
          HBOT(I,J)   = REAL(LLMH)  
          CNVTOP(I,J) = REAL(LLMH) 
          CNVBOT(I,J) = REAL(LLMH)
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     KAIN_FRITSCH VARAIBLES                                  
C                                                             
C                                                             
C...INITIALIZE ARRAYS FOR KAIN-FRITSCH CONVECTIVE SCHEME...   
C                                                             
        DO J=JDIM1,JDIM2                                      
        DO I=IDIM1,iDIM2                                      
          NCA(I,J) = 0                                        
          NCAD(I,J) = 0                                       
          RAINCV(I,J)=0.                                      
c...additional diagnostics                                    
          PPTKF(I,J) = 0.                                     
          PPTCA(I,J) = 0.                                     
c...additional diagnostics                                    
          TNCA(I,J) = 0.                                      
          PSRC(I,J) = 0.                                      
          PCLB(I,J) = 0.                                      
          UMFB(I,J) = 0.                                      
          SPSRC(I,J) = 0.                                     
          SPCLB(I,J) = 0.                                     
          SUMFB(I,J) = 0.                                     
          CIN(I,J) = 0.                                       
c...xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                    
        ENDDO                                                 
        ENDDO                                                 
C                                                             
        DO L = 1,LM                                           
          DO J=JDIM1,JDIM2                                    
          DO I=IDIM1,IDIM2                                    
            DTDT (I,J,L)=0.                                   
            DQDT (I,J,L)=0.                                   
            DQCDT (I,J,L)=0.                                  
            W0AVG(I,J,L)=0.                                   
          ENDDO                                               
          ENDDO                                               
        ENDDO                                                 
C                                                             
C------------------------------------------------------------ 
C     INITIALIZE LOOKUP TABLE FOR WET BULB TEMPERATURES FROM  
C------------------------------------------------------------ 
c                                                             
       CALL LUTAB                                             
C                                                             
C***  NCLDCK IS DEFINED AS THE APPROXIMATE NUMBER OF TIME STE 
C***  10 MINS.  KF SCHEME WILL BE CALLED AT THIS FREQUENCY.   
C***  NOTE THAT IF YOU CHANGE THIS TIME PERIOD, YOU WILL ALSO 
C***  TIME PERIOD USED FOR CALCULATING AN APPROXIMATE RUNNING 
C***  VERTICAL VELOCITY (see code in EBUKF.f)...              
C                                                             
        NCLDCK=NINT(600./DT)                                  
        PRINT*,'NCLDCK 1 ', NCLDCK                            
        NCLDCK=MAX0(NCLDCK,1)                                 
        PRINT*,'NCLDCK 2 ', NCLDCK                            
        TST=REAL(NCLDCK)


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 (NSTART .EQ. 0) THEN
!        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 (NSTART .EQ. 0) THEN
!        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 (NSTART .EQ. 0) THEN
!        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.
            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     
        IF (NSTART .EQ. 0) THEN
!        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***  IF KF TENDENCIES ARE NOT AVAILABLE FROM RESTRT FILE,    
C***  THEY MUST BE SET TO ZERO INITIALLY.                     
C                                                             
        DO 110 J=JDIM1,JDIM2                                  
        DO 110 I=IDIM1,IDIM2                                  
          NCA(I,J) = 0                                        
          NCAD(I,J) = 0                                       
          RAINCV(I,J)=0.                                      
c...additional diagnostics                                    
          PPTKF(I,J) = 0.                                     
          PPTCA(I,J) = 0.                                     
c...additional diagnostics                                    
          TNCA(I,J) = 0.                                      
          PSRC(I,J) = 0.                                      
          PCLB(I,J) = 0.                                      
          UMFB(I,J) = 0.                                      
          SPSRC(I,J) = 0.                                     
          SPCLB(I,J) = 0.                                     
          SUMFB(I,J) = 0.                                     
          CIN(I,J) = 0.                                       
 110    CONTINUE                                              
C                                                             
        DO 120 L = 1,LM                                       
        DO 120 J=JDIM1,JDIM2                                  
        DO 120 I=IDIM1,IDIM2                                  
          DTDT (I,J,L)=0.                                     
          DQDT (I,J,L)=0.                                     
          DQCDT (I,J,L)=0.                                    
          W0AVG(I,J,L)=0.                                     
 120    CONTINUE                                              
C------------------------------------------------------------ 
C     INITIALIZE LOOKUP TABLE FOR WET BULB TEMPERATURES FROM  
C------------------------------------------------------------ 
C                                                             
       CALL LUTAB                                             
C                                                             
C***  NCLDCK IS DEFINED AS THE APPROXIMATE NUMBER OF TIME STE 
C***  10 MINS.  KF SCHEME WILL BE CALLED AT THIS FREQUENCY.   
C***  NOTE THAT IF YOU CHANGE THIS TIME PERIOD, YOU WILL ALSO 
C***  TIME PERIOD USED FOR CALCULATING AN APPROXIMATE RUNNING 
C***  VERTICAL VELOCITY.                                      
C                                                             
        NCLDCK=NINT(600./DT)                                  
        NCLDCK=MAX0(NCLDCK,1)                                 
        TST=REAL(NCLDCK)

C     
C     SHORT WAVE RADIATION ARRAYS.
C     
        IF (NSTART .EQ. 0) THEN
!        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 (NSTART .EQ. 0) THEN
!        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
        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
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)=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
        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

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--------------------------------------------------------------------
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
