SUBROUTINE INIT
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .     
C SUBPROGRAM:    INIT        INITIALIZE VARIABLE FOR MODEL RUN
C   PRGRMMR: JANJIC          ORG: W/NP22     DATE: ??-??-??
C     
C ABSTRACT:  INIT READS IN PRIMARY AND AUXILIARY VARIABLES AND CONSTANTS
C            AND SETS INITIAL VALUES FOR OTHERS
C     
C PROGRAM HISTORY LOG:
C   87-06-??  JANJIC  -
C   92-10-27  DEAVEN  - CHANGED READS OF NHB, NFC, AND NBC TO
C                       ACCOMODATE SHORTENED RECORD LENGTHS
C   95-03-27  BLACK   - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
C   96-10-31  BLACK   - ADDED NAMELIST BCEXDATA FOR THE NESTS
C   98-06-10  ROGERS  - MADE Y2K COMPLIANT BY REPLACING CALL TO W3FI13
C                       TO W3DOXDAT
C   98-09-04  PYLE    - CHANGED TO NOT RE-INITIALIZE TSHLTR AND QSHLTR IF
C                       RESTART=TRUE
C   98-10-21  BLACK   - CHANGES FOR DISTRIBUTED MEMORY
C   98-11-17  BLACK   - ADDED CODE TO LOCATE THE INNER DOMAIN BOUNDARIES
C                       ON THE RELEVANT PE's
C   09-03-04  EBISUZAKI - remove unused IRAD
C     
C USAGE:    CALL INIT FROM MAIN PROGRAM EBU
C
C   INPUT ARGUMENT LIST:
C     NONE     
C
C   OUTPUT ARGUMENT LIST: 
C     NONE
C     
C   INPUT FILES:
C     NFC - THE INITIAL VALUES OF SFC PRESSURE, T, Q, U, AND V
C     NHB - A LARGE VARIETY OF ARRAY AND SCALAR CONSTANTS
C     NBC - THE BOUNDARY CONDITIONS AND TENDENCIES
C
C                              OR
C
C     RESTRT - A RESTART FILE WITH ALL NECESSARY QUANTITIES
C
C   OUTPUT FILES:
C     NONE
C     
C   SUBPROGRAMS CALLED:
C     UNIQUE: READ_NHB
C             READ_RESTRT
C             ZERO2
C             ZERO3
C     UTILITIES: W3LIB - W3DOXDAT
C       NONE
C     LIBRARY:
C       COMMON   - CTLBLK
C                  LOOPS
C                  MASKS
C                  DYNAM
C                  PHYS2
C                  MAPOT1
C                  VRBLS
C                  PVRBLS
C                  BOCO
C                  GRIDS
C                  ACMCLH
C                  ACMCLD
C                  ACMPRE
C                  ACMRDL
C                  ACMRDS
C                  ACMSFC
C                  CLDWTR
C                  CNVCLD
C                  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 "mpif.h"
      include "my_comm.h"
      INCLUDE "PARMETA.comm"
      INCLUDE "PARMTBL.comm"
      INCLUDE "cuparm"
      INCLUDE "parmsoil"
      INCLUDE "mpp.h"
!#include "sp.h"
C-----------------------------------------------------------------------
                              P A R A M E T E R
     & (CM1=2937.4,CM2=4.9283,CM3=23.5518,EPS=0.622,PI2=2.*3.14159265
     &, RLAG=14.8125
C
CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
C    &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4
C    &, Q2INI=1.0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4
C    &, Q2INI=.50,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4
C    &, Q2INI=.01,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=0.0
     &, Q2INI=.50  ,EPSQ2=0.2  ,EPSWET=0.0
CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
     &, Z0LAND=.10,Z0SEA=.001,FCM=.00001
     &, DTR=0.1745329E-1)
C-----------------------------------------------------------------------
                             P A R A M E T E R
     & (A1=610.78,WA=.10,WG=1.0-WA)
C
C-----------------------------------------------------------------------
                              P A R A M E T E R
!    & (IMJM=IM*JM-JM/2,JMP1=JM+1,JAM=6+2*(JM-10),LB=2*IM+JM-3
!    &, LM1=LM-1,LP1=LM+1,IMT=2*IM-1
     &  (NSTAT=1000) 
C-----------------------------------------------------------------------
C     
C                            DECLARE VARIABLES
C     
C-----------------------------------------------------------------------
                              L O G I C A L
     & RUN,RUNB,FIRST,RESTRT,SIGMA,EXBC,NEST
     &,INSIDEH,INSIDEV
C-----------------------------------------------------------------------
                              C H A R A C T E R *32
     & LABEL
                              C H A R A C T E R *40
     & CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV
     &,FILCLD,FILRAD,FILSFC
C-----------------------------------------------------------------------
                              R E A L
     & PHALF(LP1),NPEBND
C***
C***  NOTE: THE DIMENSION OF THE FOLLOWING ARRAYS IS ARBITRARILY CHOSEN
C***        TO EXCEED ANY NUMBER OF BOUNDARY POINTS THAT MIGHT EXIST IN
C***        ANY INNER DOMAIN
C***
                              R E A L
     & HLATI(1500),HLONI(1500),VLATI(1500),VLONI(1500)
     &,THLONI(1500),THLATI(1500),TVLONI(1500),TVLATI(1500)
     &,TSLAT(NSTAT),TSLON(NSTAT)
C-----------------------------------------------------------------------
                              I N T E G E R
     & IDATB(3),INIDAT(8),IBCDAT(8)
C-----------------------------------------------------------------------
!#ifdef DP_REAL
!      LOGICAL*8 RUNBX
!      INTEGER*8 IDATBX(3),IHRSTBX
!#endif
C-----------------------------------------------------------------------
C     
C     INCLUDE COMMON BLOCKS.
C
      INCLUDE "CTLBLK.comm"
      INCLUDE "LOOPS.comm"
      INCLUDE "MASKS.comm"
      INCLUDE "DYNAM.comm"
      INCLUDE "PHYS2.comm"
      INCLUDE "MAPOT1.comm"
      INCLUDE "VRBLS.comm"
      INCLUDE "CONTIN.comm"
      INCLUDE "PVRBLS.comm"
      INCLUDE "BOCO.comm"
      INCLUDE "ACMCLH.comm"
      INCLUDE "ACMCLD.comm"
      INCLUDE "ACMPRE.comm"
      INCLUDE "ACMRDL.comm"
      INCLUDE "ACMRDS.comm"
      INCLUDE "ACMSFC.comm"
      INCLUDE "CLDWTR.comm"
      INCLUDE "CNVCLD.comm"
      INCLUDE "SOIL.comm"
      INCLUDE "INDX.comm"
      INCLUDE "Z0EFFT.comm"
      INCLUDE "TEMPV.comm"
C-----------------------------------------------------------------------
C***
C***  THE FOLLOWING IS FOR TIMIMG PURPOSES ONLY
C***
      real*8 timef
      real nhb_tim,nhb_tim_0
      common/timing/surfce_tim,nhb_tim,res_tim,exch_tim
C-----------------------------------------------------------------------
         integer(4),pointer::lvl(:,:)
                             C O M M O N /RD1TIM/
     1 K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1
!    2,LVL(IDIM1:IDIM2,JDIM1:JDIM2)
     2,LVL
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/
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
C
C***********************************************************************
C     START INIT HERE.
C     
C     CALCULATE THE I-INDEX EAST-WEST INCREMENTS
C
      DO J=1,JM
        IHEG(J)=MOD(J+1,2)
        IHWG(J)=IHEG(J)-1
        IVEG(J)=MOD(J,2)
        IVWG(J)=IVEG(J)-1
      ENDDO
C     
C     CALCULATE THE INDIRECT I INDICES FOR RADTN
C
      KNT=0
      DO I=1,IM
        KNT=KNT+1
        IRADG(KNT)=I
      ENDDO
      DO I=1,IM-1
        KNT=KNT+1
        IRADG(KNT)=IM+2+I
      ENDDO
C
C     ZERO OUT LOCALLY INDEXED ARRAYS
C
      CALL ZERO2(PDSL)
      CALL ZERO3(T,LM)
      CALL ZERO3(Q,LM)
      CALL ZERO3(U,LM)
      CALL ZERO3(V,LM)
      CALL ZERO2(RES)
      CALL ZERO3(RTOP,LM)
      CALL ZERO3(OMGALF,LM)
      CALL ZERO3(DIV,LM)
      CALL ZERO3(ETADT,LM-1)
      CALL ZERO3(HTM,LM)
      CALL ZERO3(VTM,LM)
      CALL ZERO2(HBM2)
      CALL ZERO2(AKMS)
      CALL ZERO2(UZ0)
      CALL ZERO2(VZ0)
      CALL ZERO2(FAD)
C---------------------------------------------------------------
C
C     READ Z0 EFFECTIVE
C
      DO N=1,4
        IF(MYPE.EQ.0)THEN
          READ(22)TEMP1
        ENDIF
        CALL DSTRB(TEMP1,ZEFFIJ,1,4,N)
      ENDDO
C---------------------------------------------------------------
C***
C***  READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB
C***
      NHB=12
      LSL  =LSM
      btim=timef()
      CALL READ_NHB(NHB)
      nhb_tim=timef()-btim
           call mpi_reduce(nhb_tim,nhb_tim_0,1,mpi_real,
     *                     mpi_max,0,my_comm,ierr)
           if(mype.eq.0)then
             write(6,*)' READ NHB FILE, time = ',
     *                    nhb_tim_0*1.e-03
           endif
           CALL MPI_BARRIER(my_comm,ISTAT)
C
C---------------------------------------------------------------
      NHIBU = 12
      IF(MYPE.EQ.0)WRITE(LIST,*)'INIT:  READ CONSTANTS FILE'
C
C
C     READ NAMELIST FCSTDATA WHICH CONTROLS TIMESTEPS, 
C     ACCUMULATION PERIODS, STANDARD OUTPUT
C
      RESTRT = .FALSE.
      REWIND 11
      READ(11,FCSTDATA)
C     
      IF(MYPE.EQ.0)THEN
        WRITE(LIST,*)'INIT:  READ NAMELIST FCSTDATA - LISTED BELOW'
        WRITE(LIST,*)'  TSTART,TEND  :  ',TSTART,TEND
        WRITE(LIST,*)'  TCP          :  ',TCP
        WRITE(LIST,*)'  RESTRT       :  ',RESTRT
        WRITE(LIST,*)'  SINGLRST     :  ',SINGLRST
        WRITE(LIST,*)'  SUBPOST      :  ',SUBPOST
        WRITE(LIST,*)'  NMAP,NPHS    :  ',NMAP,NPHS
        WRITE(LIST,*)'  NCNVC        :  ',NCNVC
        WRITE(LIST,*)'  NRADSH,NRADLH:  ',NRADSH,NRADLH
        WRITE(LIST,*)'  NTDDMP       :  ',NTDDMP
        WRITE(LIST,*)'  TPREC,THEAT  :  ',TPREC,THEAT
        WRITE(LIST,*)'  TCLOD,TRDSW  :  ',TCLOD,TRDSW
        WRITE(LIST,*)'  TRDLW,TSRFC  :  ',TRDLW,TSRFC
        WRITE(LIST,*)'  TSHDE (POSTED FORECAST HOURS) BELOW:  '
        WRITE(LIST,75) (TSHDE(K),K=1,61)
        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 (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***
C      DO I=MYIS,MYIE
C        IRAD(I)=IRADG(I+MY_IS_GLB-1)-MY_IS_GLB+1
C      ENDDO
C-------------------------------------------------------------
C***
C***  READ INITIAL CONDITIONS OR RESTART FILE.
C***
      btim=timef()
      IF(SINGLRST)THEN
              btim=timef()
        CALL READ_RESTRT
              rst_tim=timef()-btim
              call mpi_reduce(rst_tim,rst_tim_0,1,mpi_real,
     *                        mpi_max,0,my_comm,ierr)
              if(mype.eq.0)then
                write(6,*)' READ BIG RESTART FILE, time = ',
     *                         rst_tim_0*1.e-03
              endif
              CALL MPI_BARRIER(my_comm,ISTAT)
!       call CHKOUTan      !  write out again as mini file for later use at end of analyis
      ELSE
              btim=timef()
        CALL READ_RESTRT2
              rst_tim=timef()-btim
              call mpi_reduce(rst_tim,rst_tim_0,1,mpi_real,
     *                        mpi_max,0,my_comm,ierr)
              if(mype.eq.0)then
                write(6,*)' READ LITTLE RESTART FILES, time = ',
     *                         rst_tim_0*1.e-03
              endif
              CALL MPI_BARRIER(my_comm,ISTAT)
      ENDIF
C-------------------------------------------------------------
C
      CALL READGRDETA

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            for analysis, skip past read of bcs for now--figure out what to do later

      iskipbcs=1 ; if(iskipbcs.eq.1) go to 9787 
!     iskipbcs=1 ; if(iskipbcs.eq.1) return
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      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)
        CALL EXIT(2)
  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.')
          CALL EXIT(3)
        ENDIF
      ENDIF
C     
C-------------------------------------------------------------
C
C     READ BOUNDARY CONDITIONS.
C     
C-------------------------------------------------------------
      IF(MYPE.EQ.0)THEN
        REWIND NBC
!#ifdef DP_REAL
!        READ(NBC)RUNBX,IDATBX,IHRSTBX,TBOCO
!        RUNB=RUNBX
!        IDATB=IDATBX
!        IHRSTB=IHRSTBX
!#else
        READ(NBC)RUNB,IDATB,IHRSTB,TBOCO
!#endif
      ENDIF
C
      CALL MPI_BCAST(RUNB,1,MPI_LOGICAL,0,my_comm,IRTN)
      CALL MPI_BCAST(IDATB,3,MPI_INTEGER,0,my_comm,IRTN)
      CALL MPI_BCAST(IHRSTB,1,MPI_INTEGER,0,my_comm,IRTN)
      CALL MPI_BCAST(TBOCO,1,MPI_REAL,0,my_comm,IRTN)
C
      CALL MPI_BARRIER(my_comm,IRTN)
C
      IBCDAT(1) = IDATB(3)
      IBCDAT(2) = IDATB(1)
      IBCDAT(3) = IDATB(2)
      IBCDAT(4) = 0
      IBCDAT(5) = IHRSTB * 0.01
c     
      INIDAT(1) = IDAT(3)
      INIDAT(2) = IDAT(1)
      INIDAT(3) = IDAT(2) 
      INIDAT(4) = 0
      INIDAT(5) = IHRST * 0.01
C
      DO IER = 6,8
       IBCDAT(IER) = 0
       INIDAT(IER) = 0
      ENDDO
C
      CALL W3DOXDAT(IBCDAT,IBCDOW,IBCDOY,JBCDAY)
      CALL W3DOXDAT(INIDAT,INDOW,INDOY,JMDDAY)
      JBCHR  = JBCDAY*24 + IHRSTB
      JMDHR  = JMDDAY*24 + IHRST
      JDIFHR = JMDHR     - JBCHR
      IF(MYPE.EQ.0)WRITE(LIST,*)'INIT:  READ BOUNDARY CONDITIONS'
C
      IF(JDIFHR.NE.0)THEN
        ITBOCO=NINT(TBOCO)
        NPOSIT=JDIFHR/ITBOCO+1
C
        IF(MYPE.EQ.0)THEN
          WRITE(LIST,*)' LOOP NPOSIT=',NPOSIT,' TIMES TO READ BC'
        ENDIF
C
        IF(RESTRT)THEN
          IF(MYPE.EQ.0)THEN
            WRITE(LIST,*)'  ',NPOSIT,' DUMMY READS INTO NBC=',
     1                   NBC,'.  USE BC IN IC.'
          ENDIF
        ELSE
          IF(MYPE.EQ.0)THEN
            WRITE(LIST,*)'INIT:  ',NPOSIT,' READS INTO NBC=',
     1                   NBC,' FOR BC'
          ENDIF
        ENDIF
        DO NRD=1,NPOSIT
          IF(RESTRT)THEN
            IF(MYPE.EQ.0)THEN
              READ(NBC)BCHR
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
            ENDIF
          ELSE
            IF(MYPE.EQ.0)THEN
              READ(NBC)BCHR
              READ(NBC)PDB
              READ(NBC)TB
              READ(NBC)QB
              READ(NBC)UB
              READ(NBC)VB
              READ(NBC)Q2B
              READ(NBC)CWMB
            ELSE
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
              READ(NBC)DUMMY
            ENDIF
            CALL MPI_BCAST(BCHR,1,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(PDB(1,1),2*LB,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(TB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(QB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(UB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(VB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(Q2B(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
            CALL MPI_BCAST(CWMB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                     my_comm,IRTN)
C
            CALL MPI_BARRIER(my_comm,IRTN)
          ENDIF
        ENDDO
      ELSE 
        IF(MYPE.EQ.0)THEN
          READ(NBC)BCHR
          READ(NBC)PDB
          READ(NBC)TB
          READ(NBC)QB
          READ(NBC)UB
          READ(NBC)VB
          READ(NBC)Q2B
          READ(NBC)CWMB
        ENDIF
C
        CALL MPI_BCAST(BCHR,1,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(PDB(1,1),2*LB,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(TB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(QB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(UB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(VB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(Q2B(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
        CALL MPI_BCAST(CWMB(1,1,1),2*LB*LM,MPI_REAL,0,
     1                 my_comm,IRTN)
C
        CALL MPI_BARRIER(my_comm,IRTN)
C
        IF(MYPE.EQ.0)WRITE(LIST,*)'  READ UNIT NBC=',NBC
      ENDIF
C***
C***  COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ
C***
      NBOCO=INT(BCHR*TSPH+0.5)
C
      IF(NTSD.EQ.NBOCO)THEN
        IF(MYPE.EQ.0)THEN
          BACKSPACE NBC
          BACKSPACE NBC
          BACKSPACE NBC
          BACKSPACE NBC
          BACKSPACE NBC
          BACKSPACE NBC
          BACKSPACE NBC
          WRITE(LIST,*)'  BACKSPACE UNIT NBC=',NBC
        ENDIF
      ENDIF
9787  continue    !   skip to here for now, bypassing read of bcs for moment in analysis
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
      APHTIM=0.0
      ARATIM=0.0
      ACUTIM=0.0
C-------------------------------------------------------------
C     
C     INITIALIZE PHYSICS VARIABLES IF STARTING THIS RUN FROM SCRATCH.
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)   = REAL(LLMH)
          HBOT(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,LMH(I,J))*(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 
        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        INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
C        VALUE (EPSQ2) ABOVE GROUND.  SET TKE TO ZERO IN THE
C        THE LOWEST MODEL LAYER.  IN THE LOWEST TWO ATMOSPHERIC
C        ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
C
        DO L=1,LM1
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            Q2(I,J,L)=HTM(I,J,L+1)*HBM2(I,J)*EPSQ2
          ENDDO
          ENDDO
        ENDDO
C
        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
        DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
          Q2(I,J,LM)    = 0.
          LLMH          = LMH(I,J)
          Q2(I,J,LLMH-2)= HBM2(I,J)*Q2INI
          Q2(I,J,LLMH-1)= HBM2(I,J)*Q2INI
        ENDDO
        ENDDO
C     
C     PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
C     INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
C
        DO L=1,LM
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            IF(Q(I,J,L).LT.EPSQ)Q(I,J,L)=EPSQ*HTM(I,J,L)
            TRAIN(I,J,L)=0.
            TCUCN(I,J,L)=0.
          ENDDO
          ENDDO
        ENDDO
C     
C     END OF SCRATCH START INITIALIZATION BLOCK.
C
        IF(MYPE.EQ.0)THEN
          WRITE(LIST,*)'INIT:  INITIALIZED ARRAYS FOR CLEAN START'
        ENDIF
      ENDIF
C
C
C
C     RESTART INITIALIZING.  CHECK TO SEE IF WE NEED TO ZERO
C     ACCUMULATION ARRAYS.
C
      IF(RESTRT)THEN
C
C       AVERAGE CLOUD AMOUNT ARRAY
C
        IF(MOD(NTSD,NCLOD).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO AVG CLD AMT ARRAY'
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ACFRCV(I,J)=0.
            NCFRCV(I,J)=0
            ACFRST(I,J)=0.
            NCFRST(I,J)=0
          ENDDO
          ENDDO
        ENDIF
C     
C        GRID-SCALE AND CONVECTIVE LATENT HEATING ARRAYS.
C     
        IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN
          IF(MYPE.EQ.0)THEN
            WRITE(LIST,*)'  ZERO ACCUM LATENT HEATING ARRAYS'
          ENDIF
C
          AVRAIN=0.
          AVCNVC=0.
          DO L=1,LM
            DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
            DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
              TRAIN(I,J,L)=0.
              TCUCN(I,J,L)=0.
            ENDDO
            ENDDO
          ENDDO
        ENDIF
C***
C***  IF THIS IS NOT A NESTED RUN, INITIALIZE TKE
C***
        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
C***
C***  CLOUD EFFICIENCY
C***
        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
C     
C     TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
C     TOTAL SNOW AND SNOW MELT ARRAYS.
C     STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
C     
        IF(MOD(NTSD,NPREC).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO ACCUM PRECIP ARRAYS'
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ACPREC(I,J)=0.
            CUPREC(I,J)=0.
            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(MOD(NTSD,NRDLW).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO ACCUM LW RADTN ARRAYS'
          ARDLW=0.
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ALWIN(I,J) =0.
            ALWOUT(I,J)=0.
            ALWTOA(I,J)=0.
          ENDDO
          ENDDO
        ENDIF
C     
C     SHORT WAVE RADIATION ARRAYS.
C     
        IF(MOD(NTSD,NRDSW).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO ACCUM SW RADTN ARRAYS'
          ARDSW=0.
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ASWIN(I,J) =0.
            ASWOUT(I,J)=0.
            ASWTOA(I,J)=0.
          ENDDO
          ENDDO
        ENDIF
C     
C     SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS.
C     
        IF(MOD(NTSD,NSRFC).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO ACCUM SFC FLUX ARRAYS'
          ASRFC=0.
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            SFCSHX(I,J)=0.
            SFCLHX(I,J)=0.
            SUBSHX(I,J)=0.
            SNOPCX(I,J)=0.
            SFCUVX(I,J)=0.
            SFCEVP(I,J)=0.
            POTEVP(I,J)=0.
            POTFLX(I,J)=0.
          ENDDO
          ENDDO
        ENDIF
C
C     ENDIF FOR RESTART FILE ACCUMULATION ZERO BLOCK.
C
        IF(MYPE.EQ.0)THEN
          WRITE(LIST,*)'INIT:  INITIALIZED ARRAYS FOR RESTART START'
        ENDIF
      ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C
C     INITIALIZE CLOUD CONSTANTS
C
C-----------------------------------------------------------------------
      DO 350 J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
      DO 350 I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
      U00(I,J)=(1.-SM(I,J))*0.75+SM(I,J)*0.80
  350 CONTINUE
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
      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
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
      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
          SI(I,J)=0.0
          DO NS=1,NSOIL
            SMC(I,J,NS)=1.0
            STC(I,J,NS)=273.16
            SH2O(I,J,NS)=1.0
          ENDDO
        ENDIF
C
      ENDDO
      ENDDO
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)     !   skipping radiation stuff at presenty for analysis
C   
C    CALL SOLARD TO CALCULATE NON-DIMENSIONAL SUN-EARTH DISTANCE
C   
!     IF(MYPE.EQ.0)CALL SOLARD(RAD1)                        !  skipping radiation stuff
!     CALL MPI_BCAST(RAD1,1,MPI_REAL,0,my_comm,IRTN)    !  for now
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)         ! skipping radiation stuff for now
      ADDL=0.                            ! skipping radiation stuff for now
      IF(MOD(IDAT(3),4).EQ.0)ADDL=1.                ! skipping radiation stuff for now
      RANG=PI2*(DAYI-RLAG)/(365.25+ADDL)          ! skipping radiation stuff for now
      RSIN1=SIN(RANG)                          ! skipping radiation stuff for now
      RCOS1=COS(RANG)                          ! skipping radiation stuff for now
      RCOS2=COS(2.*RANG)                      ! skipping radiation stuff for now
      CALL O3CLIM             !  skipping radiation stuff for now
C
C-------------------------------------------------------------------
C***  SOME INITAL 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)
        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
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
        THLM=TLM*APELM
        DPLM=PDSL(I,J)*DETA(LMHK)*0.5
        DZLM=287.06*DPLM*TLM*(1.+0.608*QLM)/(9.801*PLM)

        FAC1=30./DZLM
        FAC2=(DZLM-30.)/DZLM
        IF(DZLM.LE.30.)THEN
          FAC1=1.
          FAC2=0.
        ENDIF
C
        IF(.NOT.RESTRT)THEN
          TH30(I,J)=FAC2*THS(I,J)+FAC1*THLM
          Q30(I,J)=FAC2*QS(I,J)+FAC1*QLM
          U30(I,J)=ULM
          V30(I,J)=VLM
        ENDIF
C
        FAC1=10./DZLM
        FAC2=(DZLM-10.)/DZLM
        IF(DZLM.LE.10.)THEN
          FAC1=1.
          FAC2=0.
        ENDIF
C 
        IF(.NOT.RESTRT)THEN
          TH10(I,J)=FAC2*THS(I,J)+FAC1*THLM
          Q10(I,J)=FAC2*QS(I,J)+FAC1*QLM
          U10(I,J)=ULM
          V10(I,J)=VLM
        ENDIF
C
        FAC1=2./DZLM
        FAC2=(DZLM-2.)/DZLM
        IF(DZLM.LE.2.)THEN
          FAC1=1.
          FAC2=0.
        ENDIF
C
        IF(.NOT.RESTRT)THEN
          TSHLTR(I,J)=FAC2*THS(I,J)+FAC1*THLM
          QSHLTR(I,J)=FAC2*QS(I,J)+FAC1*QLM
        ENDIF
C***
C***  NEED TO CONVERT TO THETA IF IS THE RESTART CASE
C***  AS CHKOUT.f WILL CONVERT TO TEMPERATURE
C***  THIS IS THE ANALYSIS SO WHY DO THIS!
C***
c       IF(RESTRT)THEN
c         TSHLTR(I,J)=TSHLTR(I,J)*APELMNW
c       ENDIF
      ENDDO
      ENDDO
C
C--------------------------------------------------------------------
C     END OF SUBROUTINE INIT.
C-------------------------------------------------------------------
C
      IF(MYPE.EQ.0)THEN
        WRITE(LIST,*)'INIT:  EXIT INIT AND START MODEL INTEGRATION'
        WRITE(LIST,*)' '
      ENDIF
C
      RETURN
      END
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!     BLOCK DATA CLOUD
!     INCLUDE "parmeta"
C-----------------------------------------------------------------------
!                            C O M M O N /RD1TIM/
!    1 K400,CTHK(3),LTOP(3),PTOPC(4),TAUCV(3),RAD1
!    2,LVL(IDIM1:IDIM2,JDIM1:JDIM2)
C-----------------------------------------------------------------------
!		     D A T A
!    1 CTHK/20000.0,20000.0,20000.0/
!    1,TAUCV/0.16, 0.14, 0.12/, LTOP/0,0,0/
C-----------------------------------------------------------------------
!     END BLOCK DATA CLOUD