      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   14-07-XX  KATSAFADOS - UPDATES FOR fcstdata namelist FOR COUPLING WITH OCEAN WAVE
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                  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 "wave.inc"
#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---------- ioannis  ---------------------------------------------------
                              L O G I C A L
     & RUN,RUNB,FIRST,RESTRT,SIGMA,EXBC,NEST
     &,INSIDEH,INSIDEV
                              L O G I C A L        
     & PRINT_FIELDS, PRINT_GROUND, RUN_DUST,PREPARE_NEST
     &,PRINT_INIT, Z0contant,FL_SLOPES, UPDATE_SM
C-----------------------------------------------------------------------

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---------- ioannis  ---------------------------------------------------
       CHARACTER CDAT*3, TITLE1*18, TITLE2*18
       CHARACTER*128 FFNAME, FNAME
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---------- ioannis      -----------------------------------------------
       REAL Z0_VEG(13),TEMPSOIL(IM,JM,NSOIL)
                              I N T E G E R
     & IDATPRE(3), IDATNEW(3), MONTH(12)
      CHARACTER*100         FN_VOUT
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 "CNVCLD.comm"
      INCLUDE "SOIL.comm"
      INCLUDE "INDX.comm"
      INCLUDE "Z0EFFT.comm"
      INCLUDE "TEMPV.comm"
      INCLUDE "FCSTPAR.comm"  ! ioannis
      INCLUDE "WAVES.comm"  ! cpk
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-----------------------------------------------------------------------
C---------- ioannis      -----------------------------------------------
      DATA Z0_VEG/2.653, 0.826, 0.563, 1.089, 0.854, 0.856, 0.075,
     &            0.238, 0.065, 0.076, 0.011, 0.075, 0.011/
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/
                             D A T A
     & MONTH/31,28,31,30,31,30,31,31,30,31,30,31/
!
!--- Flag for initializing microphysical statistics
!
      COMMON /CMICRO_START/ MICRO_START
      LOGICAL :: MICRO_START
C-----------------------------------------------------------------------
C     
C     DECLARE NAMELISTS.
C
cioannis1      NAMELIST /FCSTDATA/
cioannis1     & TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL
cioannis1     &,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP
cioannis1     &,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC
cioannis1     &,NEST,HYDRO,SPLINE
      NAMELIST /FCSTDATA/
     & TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL
     &,NPHS,NCNVC,RADSH,RADLH,NTDDMP
     &,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC
     &,NEST,HYDRO,SPLINE
     &,HOUT,PRINT_INIT,PRINT_FIELDS,PRFIELDS,PRINT_GROUND
     &,PRGROUND,RUN_DUST,PRDUST
     &,Z0contant,FL_SLOPES,UPDATE_SM
cpk ------- set wave namelist ----------------
      NAMELIST /WAVENL/COUPLE_WAVE,CTRL,DT_WAVE_RATIO,USE_U10,CHARNOCK,
     &                 RAINEFF
cpk -----------------------------------------
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
C---------------------------------------------------------------
C***
C***  READ "CONSTANT" DATA FROM UNIT CONNECTED TO NHB
C***
      NHB=12
      LSL  =LSM
      btim=timef()
      CALL READ_NHB(NHB)
      nhb_tim=timef()-btim
C
C---------------------------------------------------------------
      NHIBU = 12
      IF(MYPE.EQ.0)WRITE(LIST,*)'INIT:  READ CONSTANTS FILE'
C
C
C     READ NAMELIST FCSTDATA WHICH CONTROLS TIMESTEPS, 
C     ACCUMULATION PERIODS, STANDARD OUTPUT
C
      RESTRT = .FALSE.
      REWIND 11
      READ(11,FCSTDATA)
      READ(11,WAVENL)
      if (MYPE .eq. 0) then
         write(6,*) 'HYDRO=' , HYDRO
         write(6,*) 'SPLINE=' , SPLINE
         write(6,*) 'WAVE COUPLING=' , COUPLE_WAVE
      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
cioannis        WRITE(LIST,*)'  NRADSH,NRADLH:  ',NRADSH,NRADLH
        WRITE(LIST,*)'  NRADSH,NRADLH:  ',RADSH,RADLH
        WRITE(LIST,*)'  NTDDMP       :  ',NTDDMP
        WRITE(LIST,*)'  TPREC,THEAT  :  ',TPREC,THEAT
        WRITE(LIST,*)'  TCLOD,TRDSW  :  ',TCLOD,TRDSW
        WRITE(LIST,*)'  TRDLW,TSRFC  :  ',TRDLW,TSRFC
        WRITE(LIST,*)'  TSHDE (POSTED FORECAST HOURS) BELOW:  '
        WRITE(LIST,75) (TSHDE(K),K=1,99)
        WRITE(LIST,*)'  SPL (POSTED PRESSURE LEVELS) BELOW: '
        WRITE(LIST,80) (SPL(L),L=1,LSM)
   75   FORMAT(14(F4.1,1X))
   80   FORMAT(8(F8.1,1X))
      ENDIF
C
C     
C     SET TIME STEPPING RELATED CONSTANTS.
C
      FIRST  = .TRUE.
      NSTART = INT(TSTART*TSPH+0.5)
      NTSTM  = INT(TEND  *TSPH+0.5)+1
      NCP    = INT(TCP   *TSPH+0.5)
      NPREC  = INT(TPREC *TSPH+0.5)
      NHEAT  = INT(THEAT *TSPH+0.5)
      NCLOD  = INT(TCLOD *TSPH+0.5)
      NRDSW  = INT(TRDSW *TSPH+0.5)
      NRDLW  = INT(TRDLW *TSPH+0.5)
      NSRFC  = INT(TSRFC *TSPH+0.5)

      NHOUT  = INT(HOUT  *TSPH+0.5)          ! ioannis
      NPFIELDS = INT(PRFIELDS *TSPH+0.5)     ! ioannis
      NPGROUND = INT(PRGROUND *TSPH+0.5)     ! ioannis
      NPDUST   = INT(PRDUST   *TSPH+0.5)     ! ioannis

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
cioannis      NRADS = NINT(TSPH)*NRADSH
cioannis      NRADL = NINT(TSPH)*NRADLH
      NRADS = NINT(TSPH)*RADSH  !!!!!!! BE CAREFUL WHEN USING HP OR IBM
      NRADL = NINT(TSPH)*RADLH  !!!!!!! BE CAREFUL WHEN USING HP OR IBM
      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,*)' TSPH              :  ',TSPH             ! ioannis
        WRITE(LIST,*)' NHOUT,NPFIELDS    :  ',NHOUT,NPFIELDS   ! ioannis
        WRITE(LIST,*)' NPGROUND,NPDUST   :  ',NPGROUND,NPDUST  ! ioannis
        WRITE(LIST,*)' UPDATE_SM         :  ',UPDATE_SM        ! ioannis
        WRITE(LIST,*)' Z0contant         :  ',Z0contant        ! ioannis
        WRITE(LIST,*)'======================'
        WRITE(LIST,*)' WAVE COUPLING     :  ',COUPLE_WAVE      ! cpk
        WRITE(LIST,*)' CONTROL/COUPLING  :  ',CTRL             ! cpk
        WRITE(LIST,*)' DT_WAVE_RATIO     :  ',DT_WAVE_RATIO    ! cpk
        WRITE(LIST,*)' USE_U10           :  ',USE_U10    ! cpk
        WRITE(LIST,*)' CHARNOCK coeff.   :  ',CHARNOCK    ! cpk
        WRITE(LIST,*)' EFFECT OF RAIN    :  ',RAINEFF    ! cpk
        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
cioannis      UPDATE_SM=.TRUE.    ! ioannis
      FN_VOUT='../../output/RUN/v_out.'  ! ioannis

C
C
C----------  UPDATE Soil Moisture-Temperature from previous run --------- 
C        The site for updating temp-moist from previous run
C
         IF(UPDATE_SM) THEN
           FFNAME=FN_VOUT(1:(INDEX(FN_VOUT,' '))-1)//'000.ground'
               OPEN(UNIT=33,FILE=FFNAME,STATUS='UNKNOWN',
     &              ACCESS='SEQUENTIAL',FORM='UNFORMATTED')
               READ(33) IDATPRE,IHRSTPRE,IHRPRE,LABEL
               CLOSE(33)

           IF (MOD(IDAT(3),4).EQ.0) MONTH(2) = 29
           IF (IDAT(3).gt.IDATPRE(3)) THEN
              IF(IDAT(1).lt.IDATPRE(1)) THEN
                 IDAY = IDAT(2) + month(12) - IDATPRE(2)
              ENDIF
           ENDIF
           IF (IDAT(2).lt.IDATPRE(2)) THEN
              IDAY = IDAT(2) + month(IDATPRE(1)) - IDATPRE(2)
           ELSE
              IDAY = IDAT(2) - IDATPRE(2)
           ENDIF
           ITIME = IDAY * 24 + (IHRST - IHRSTPRE)
           WRITE(CDAT(1:3),'(i3.3)') ITIME
           TITLE1(1:18)='xx.xx.xx at xx UTC'
           write(TITLE1(1:2),'(i2.2)')IDAT(2)
           write(TITLE1(4:5),'(i2.2)')IDAT(1)
           write(TITLE1(7:8),'(i2.2)')mod(IDAT(3),100)
           write(TITLE1(13:14),'(i2.2)')IHRST
           TITLE2(1:18)='xx.xx.xx at xx UTC'
           write(TITLE2(1:2),'(i2.2)')IDATPRE(2)
           write(TITLE2(4:5),'(i2.2)')IDATPRE(1)
           write(TITLE2(7:8),'(i2.2)')mod(IDATPRE(3),100)
           write(TITLE2(13:14),'(i2.2)')IHRSTPRE
 
           IF (ITIME.LE.120) THEN
              FFNAME=
     &        FN_VOUT(1:(INDEX(FN_VOUT,' '))-1)//CDAT//'.ground'
              ISTR=INDEX(FFNAME,' ')-1
              OPEN(UNIT=33,FILE=FFNAME,STATUS='UNKNOWN',
     &             ACCESS='SEQUENTIAL',FORM='UNFORMATTED')
              READ(33) IDATPRE,IHRSTPRE,IHRPRE,LABEL
              READ(33) TEMPSOIL ! SMC
              CALL DSTRB(TEMPSOIL,SMC,NSOIL,NSOIL,NSOIL)
              READ(33) TEMPSOIL ! STC
              CALL DSTRB(TEMPSOIL,STC,NSOIL,NSOIL,NSOIL)
              READ(33) TEMP1    ! SNO
              CALL DSTRB(TEMP1,SNO,1,1,1)
              READ(33) TEMP1    ! vegfrc
              READ(33) TEMPSOIL ! SH2O
              CALL DSTRB(TEMPSOIL,SH2O,NSOIL,NSOIL,NSOIL)
              READ(33) TEMP1    ! SI
              CALL DSTRB(TEMP1,SI,1,1,1)
              CLOSE(33)
              IF (MYPE.EQ.0) THEN
               write(6,*)'SMC and STC from previous run based on:'
               write(6,*)TITLE2(1:18),' reading file ',FFNAME(1:ISTR)
               write(6,*)'Valid for : ', TITLE1(1:18)
c ***** ioannis new ******
c             write(6,*) 'ioannisSMC is ',SMC(30,10,1)
c     $,SMC(30,10,2),SMC(30,10,3),SMC(30,10,4)
c             write(6,*) 'ioannisSH2O is ',SH2O(30,10,1)
c     $,SH2O(30,10,2),SH2O(30,10,3),SH2O(30,10,4)
c             write(6,*) 'ioannisSTC is ',STC(10,10,1)
c     $,STC(30,10,2),STC(30,10,3),STC(30,10,4)
c ************************
              ENDIF
            ELSE
              IF (MYPE.EQ.0) THEN
               write(6,*)'Previous run not valid for updating SMC-STC'
               write(6,*)'Reading SMC-STC from preprocessing'
              ENDIF
           ENDIF
         ELSE
           IF (MYPE.EQ.0) THEN
             write(6,*)'Updating SMC-STC from previous run is not asked'
             write(6,*)'Reading SMC-STC from preprocessing'
c ***** ioannis new ******
c             write(6,*) 'ioannisSMC is ',SMC(30,10,1)
c     $,SMC(30,10,2),SMC(30,10,3),SMC(30,10,4)
c             write(6,*) 'ioannisSH2O is ',SH2O(30,10,1)
c     $,SH2O(30,10,2),SH2O(30,10,3),SH2O(30,10,4)
c             write(6,*) 'ioannisSTC is ',STC(10,10,1)
c     $,STC(30,10,2),STC(30,10,3),STC(30,10,4)
c ************************
           ENDIF
         ENDIF
C-------------------------------------------------------------
C-------------------------------------------------------------
C
C     IF NOT RUNNING THE MODEL, PRINT DATE OF INITIAL CONDITIONS
C     JUST READ AND STOP.  OTHERWISE, CONTINUE.
C
C-------------------------------------------------------------
      IF (RUN) GO TO 190
C
      IF(MYPE.EQ.0)THEN 
        WRITE(LIST,165) IHRST,IDAT
        WRITE(LIST,166)
ccccc   CALL EXIT(2)
        CALL MPI_FINALIZE(IERR)
        STOP2
  165   FORMAT('0*** ',I2,' GMT ',2(I2,'/'),I4,' ***')
  166   FORMAT('0F*** NO INITIAL CONDITIONS. RUN TERMINATED.')
      ENDIF
C     
C     IF THE TIMESTEP COUNTER (NTSD) EXCEEDS THE "STOP MODEL" T
C     TIMESTEP,CONTINUE, STOP EXECUTION.  OTHERWISE, CONTINUE.
C
  190 IF(NTSD.GE.NTSTM)THEN
        IF(MYPE.EQ.0)THEN
          WRITE(LIST,165) IHRST,IDAT
          WRITE(LIST,195)
  195     FORMAT('0F*** FORECAST ALREADY DONE. RUN TERMINATED.')
ccccc     CALL EXIT(3)
          CALL MPI_FINALIZE(IERR)
          STOP3
        ENDIF
      ENDIF
C     
c coupling --- set the initial date/time for wave ----------------------
       write(idtpro(1:2),'(i2.2)')mod(IDAT(3),100)
       write(idtpro(3:4),'(i2.2)')IDAT(1)
       write(idtpro(5:6),'(i2.2)')IDAT(2)
       write(idtpro(7:8),'(i2.2)')IHRST
       write(idtpro(9:10),'(i2.2)')IHR
       write(idtpro(11:12),'(i2.2)')0
c coupling -------------------------------------------------------------
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
cioannis      Z0contant=.FALSE.  ! ioannis
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.

c          Z0(I,J)=SM(I,J)*Z0SEA 
c     $         + (1.-SM(I,J))*Z0_VEG(IVGTYP(I,J))  ! ioannis

          IF (SM(I,J).GT.0.5) THEN
             Z0(I,J)=Z0SEA        ! ioannis
          ELSE
             Z0(I,J)=Z0_VEG(IVGTYP(I,J))  ! ioannis
          ENDIF

          IF (Z0contant) THEN  ! ioannis
           Z0(I,J)     = SM(I,J)*Z0SEA+(1.-SM(I,J))*
     $                (FIS(I,J)*FCM+Z0LAND)
          ENDIF

          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,LLMH)*(1.+0.608*Q(I,J,LLMH))
          PSFCK=PD(I,J)+PT
C
          IF(SM(I,J).LT.0.5) THEN
            QS(I,J)=PQ0/PSFCK*EXP(A2*(TSFCK-A3)/(TSFCK-A4))
          ELSEIF(SM(I,J).GT.0.5) THEN
            THS(I,J)=SST(I,J)*(1.E5/(PD(I,J)+PT))**CAPA
          ENDIF
C
          TERM1=-0.068283/T(I,J,LLMH)
          PSHLTR(I,J)=(PD(I,J)+PT)*EXP(TERM1)
C
          USTAR(I,J)=0.1
          THZ0(I,J)=THS(I,J)
          QZ0(I,J)=QS(I,J)
          UZ0(I,J)=0.
          VZ0(I,J)=0.
C 
        ENDDO
        ENDDO
C
C     INITIALIZE CLOUD FIELDS
C
        DO L=1,LM
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            CWM(I,J,L)=0.
          ENDDO
          ENDDO
        ENDDO
C
C     INITIALIZE ACCUMULATOR ARRAYS TO ZERO.
C
        ARDSW=0.0
        ARDLW=0.0
        ASRFC=0.0
        AVRAIN=0.0
        AVCNVC=0.0
C
        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
        DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
          ACFRCV(I,J)=0.
          NCFRCV(I,J)=0
          ACFRST(I,J)=0.
          NCFRST(I,J)=0
          ACSNOW(I,J)=0.
          ACSNOM(I,J)=0.
          SSROFF(I,J)=0.
          BGROFF(I,J)=0.
          ALWIN(I,J) =0.
          ALWOUT(I,J)=0.
          ALWTOA(I,J)=0.
          ASWIN(I,J) =0.
          ASWOUT(I,J)=0.
          ASWTOA(I,J)=0.
          SFCSHX(I,J)=0.
          SFCLHX(I,J)=0.
          SUBSHX(I,J)=0.
          SNOPCX(I,J)=0.
          SFCUVX(I,J)=0.
          SFCEVP(I,J)=0.
          POTEVP(I,J)=0.
          POTFLX(I,J)=0.
        ENDDO
        ENDDO
C
C     INITIALIZE SATURATION SPECIFIC HUMIDITY OVER THE WATER.
C
        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
        DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
          IF(SM(I,J).GT.0.5)THEN
            CLOGES =-CM1/SST(I,J)-CM2*ALOG10(SST(I,J))+CM3
            ESE    = 10.**(CLOGES+2.)
            QS(I,J)= SM(I,J)*EPS*ESE/(PD(I,J)+PT-ESE*(1.-EPS))
          ENDIF
        ENDDO
        ENDDO
C     
C       PAD GROUND WETNESS IF IT IS TOO SMALL.
C
c        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
c        DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
c          WET(I,J)=AMAX1(WET(I,J),EPSWET)
c        ENDDO
c        ENDDO
C     
C        INITIALIZE TURBULENT KINETIC ENERGY (TKE) TO A SMALL
C        VALUE (EPSQ2) ABOVE GROUND.  SET TKE TO ZERO IN THE
C        THE LOWEST MODEL LAYER.  IN THE LOWEST TWO ATMOSPHERIC
C        ETA LAYERS SET TKE TO A SMALL VALUE (Q2INI).
C
        DO L=1,LM1
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            Q2(I,J,L)=HTM(I,J,L+1)*HBM2(I,J)*EPSQ2
          ENDDO
          ENDDO
        ENDDO
C
        DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
        DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
          Q2(I,J,LM)    = 0.
          LLMH          = LMH(I,J)
          Q2(I,J,LLMH-2)= HBM2(I,J)*Q2INI
          Q2(I,J,LLMH-1)= HBM2(I,J)*Q2INI
        ENDDO
        ENDDO
C     
C     PAD ABOVE GROUND SPECIFIC HUMIDITY IF IT IS TOO SMALL.
C     INITIALIZE LATENT HEATING ACCUMULATION ARRAYS.
C
        DO L=1,LM
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            IF(Q(I,J,L).LT.EPSQ)Q(I,J,L)=EPSQ*HTM(I,J,L)
            TRAIN(I,J,L)=0.
            TCUCN(I,J,L)=0.
          ENDDO
          ENDDO
        ENDDO
C     
C     END OF SCRATCH START INITIALIZATION BLOCK.
C
        IF(MYPE.EQ.0)THEN
          WRITE(LIST,*)'INIT:  INITIALIZED ARRAYS FOR CLEAN START'
        ENDIF
      ENDIF
C
C
C
C     RESTART INITIALIZING.  CHECK TO SEE IF WE NEED TO ZERO
C     ACCUMULATION ARRAYS.
C
      IF(RESTRT)THEN
C
C       AVERAGE CLOUD AMOUNT ARRAY
C
        IF(MOD(NTSD,NCLOD).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO AVG CLD AMT ARRAY'
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ACFRCV(I,J)=0.
            NCFRCV(I,J)=0
            ACFRST(I,J)=0.
            NCFRST(I,J)=0
          ENDDO
          ENDDO
        ENDIF
C     
C        GRID-SCALE AND CONVECTIVE LATENT HEATING ARRAYS.
C     
        IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN
          IF(MYPE.EQ.0)THEN
            WRITE(LIST,*)'  ZERO ACCUM LATENT HEATING ARRAYS'
          ENDIF
C
          AVRAIN=0.
          AVCNVC=0.
          DO L=1,LM
            DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
            DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
              TRAIN(I,J,L)=0.
              TCUCN(I,J,L)=0.
            ENDDO
            ENDDO
          ENDDO
        ENDIF
C***
C***  IF THIS IS NOT A NESTED RUN, INITIALIZE TKE
C***
c       IF(.NOT.NEST)THEN
c         DO L=1,LM
c           DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
c           DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
c             Q2(I,J,L)=AMAX1(Q2(I,J,L)*HBM2(I,J),EPSQ2)
c           ENDDO
c           ENDDO
c         ENDDO
c       ENDIF
C     
C     TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
C     TOTAL SNOW AND SNOW MELT ARRAYS.
C     STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
C     
        IF(MOD(NTSD,NPREC).LT.NPHS)THEN
          IF(MYPE.EQ.0)WRITE(LIST,*)'  ZERO ACCUM PRECIP ARRAYS'
          DO J=JS_LOC_TABLE(MYPE),JE_LOC_TABLE(MYPE)
          DO I=IS_LOC_TABLE(MYPE),IE_LOC_TABLE(MYPE)
            ACPREC(I,J)=0.
            CUPREC(I,J)=0.
            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
        U00(I,J)=.95
  350  CONTINUE
!
!--- Flag for Initializing arrays, lookup tables, & constants used in
!    microphysics and radiation
!
      MICRO_START=.TRUE.
!
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
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
