    PROGRAM EBU
!$$$  MAIN PROGRAM DOCUMENTATION BLOCK
!                .      .    .                                       .
! MAIN PROGRAM: ETAFCST      EARLY ETA MODEL FORECAST DRIVER
!   PRGMMR: JANJIC           ORG: NP22        DATE: 99-01-20

! ABSTRACT: EBU3 CONTAINS THE PRIMARY RUNSTREAM FOR THE EARLY ETA
!   FORECAST MODEL.  AFTER AN INITIAL CALL TO SUBROUTINE INIT, CALLS
!   ARE MADE TO SUBROUTINES WHICH COMPUTE THE VARIOUS DYNAMICAL AND
!   PHYSICAL PROCESSES IN THE MODEL.  THE VARIABLE 'NTSD' IS THE
!   FUNDAMENTAL TIMESTEP COUNTER AND THUS ITS VALUE DETERMINES WHEN
!   THE SUBROUTINES ARE CALLED.  INFORMATION PERTAINING TO THE SCHEMES
!   USED IN THE MODEL AS WELL AS ADDITIONAL REFERENCES MAY BE FOUND
!   IN "THE STEP-MOUNTAIN ETA COORDINATE REGIONAL MODEL:  A DOCUMEN-"
!   TATION" (BLACK 1988; DEVELOPMENT DIVISION) AND "THE NEW NMC MESO-
!   SCALE ETA MODEL:  DESCRIPTION AND FORECAST EXAMPLES (BLACK 1994;
!   WEATHER AND FORECASTING).

! PROGRAM HISTORY LOG:
!   87-08-??  JANJIC,     ORIGINATOR
!             BLACK
!   93-05-12  TREADON     DOCBLOCK INSERTED
!   93-10-25  BLACK       DOCBLOCK UPDATED
!   97-03-15  MESINGER    SPLITTING MODIFIED, TO SEPARATE THE
!                         ADJUSTMENT AND THE ADVECTION STEP
!   97-11-19  BLACK       MODIFIED FOR DISTRIBUTED MEMORY
!   98-10-20  BLACK       DISTRIBUTED MEMORY FORM FOR
!                         CURRENT OPERATIONAL CODE
!   00-02-25  TUCCILLO    INCORPORATED ASYNCHRONOUS I/O SERVERS
!   00-11-14  BLACK       INCORPORATED JANJIC NONHYDROSTATIC OPTION
!   00-11-27  BLACK       INCORPORATED RESTART CAPABILITY


! USAGE:  MAIN PROGRAM

!   INPUT FILES:  NONE (SEE SUBROUTINE INIT)

!   OUTPUT FILES:  NONE (SEE SUBROUTINE CHKOUT)

!   SUBPROGRAMS CALLED:
!     UNIQUE:
!       INIT     - INITIALIZE VARIABLES AT START OF INTEGRATION
!       DIVHOA   - DIVERGENCE, AND HORIZONTAL PART OF THE OMEGA-ALPHA
!                  TERM
!       PGCOR    - PRESSURE GRADIENT AND CORIOLIS FORCE
!       PDTE     - UPDATE SURFACE PRESSURE TENDENCY AND ETADOT
!       VTADV    - VERTICAL ADVECTION
!       HZADV    - HORIZONTAL ADVECTION OF T,U,V, AND TKE
!       HZADV2   - HORIZONTAL ADVECTION OF Q AND CLOUD WATER
!       DDAMP    - APPLY DIVERGENCE DAMPING
!       PDNEW    - UPDATE SURFACE PRESSURE
!       HDIFF    - LATERAL DIFFUSION
!       BOCOH    - UPDATE H POINTS ON THE BOUNDARIES
!       BOCOV    - UPDATE V POINTS ON THE BOUNDARIES
!       RADTN    - RADIATION DRIVER
!       RDTEMP   - APPLY TEMPERATURE TENDENCY DUE TO RADIATION
!       TURBL    - PERFORM THE VERTICAL TURBULENT EXCHANGE
!       SURFACE  - UPDATE SURFACE TEMPERATURE, MOISTURE, AND OTHER
!                  GROUND HYDROLOGY
!       GSCOND   - CLOUD WATER/ICE PHYSICS PARAMETERIZATION (EDAS only)
!       CUCNVC   - CONVECTIVE ADJUSTMENT FOR DEEP OR SHALLOW CONVECTION
!       PRECPD   - GRID SCALE PRECIPITATION (EDAS only)
!       GSMDRIVE - GRID SCALE MICROPHYSICS DRIVER (free forecast only)
!       ADJPPT   - adjust model precipitation to observations
!       CLTEND   - UPDATE TEMPERATURE FROM (GRID- AND SUBGRID-SCALE) CLOUD PROCESSES
!       CHKOUT   - POST PROFILE DATA.  FOR INTERNAL POST,
!                  POSTS MODEL OUTPUT.  FOR EXTERNAL POST,
!                  WRITES TEMPORARY FILE CONTAINING ALL MODEL
!                  ARRAYS.

!   EXIT STATES:
!     COND =   1 - NORMAL EXIT

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP

!$$$

!     ******************************************************************
!     *                                                                *
!     *                   LIMITED AREA ETA MODEL                       *
!     *                WITH STEP-MOUNTAIN TOPOGRAPHY                   *
!     *                                                                *
!     *                                                                *
!     *    NOAA / NATIONAL CENTERS FOR ENVIRONMENTAL PREDICTION,       *
!     *                                             CAMP SPRINGS, MD   *
!     *                                                                *
!     *  GEOPHYSICAL FLUID DYNAMICS LABORATORY / NOAA, PRINCETON, NJ,  *
!     *                                                                *
!     *  UNIVERSITY CORPORATION FOR ATMOSPHERIC RESEARCH, BOULDER, CO, *
!     *                              &                                 *
!     * DEPARTMENT OF METEOROLOGY, UNIVERSITY OF BELGRADE, YUGOSLAVIA  *
!     *                                                                *
!     ******************************************************************

!     ******************************************************************
!     *                                                                *
!     *                        REFERENCES                              *
!     *             FOR THE DYNAMICAL PART OF THE MODEL                *
!     *                                                                *
!     *  STEP-MOUNTAIN ETA COORDINATE:                                 *
!     *      F. MESINGER, 1983, IN RES. ACTIVITIES IN ATMOS. AND       *
!     *      OCEANIC MODELING, REP. NO. 5, WMO, GENEVA, 4.9-4.10.      *
!     *                                                                *
!     *  HORIZONTAL ADVECTION, CONTINUITY EQUATION:                    *
!     *      Z.I. JANJIC, 1984, MWR, 112, NO.6, 1234-1245.             *
!     *                                                                *
!     *  INTERNAL BOUNDARIES, OMEGA-ALPHA TERM, CODING, PERFORMANCE:   *
!     *      MESINGER ET AL., 1988, MWR, 116 NO.7, 1493-1518.          *
!     *                                                                *
!     *  N.B. FOR MORE DETAILS ON THESE TOPICS SEE ALSO:               *
!     *                                                                *
!     *  1.  MESINGER, F., AND Z.I. JANJIC, 1985: PROBLEMS AND         *
!     *        NUMERICAL METHODS OF THE INCORPORATION OF MOUNTAINS IN  *
!     *        ATMOSPHERIC MODELS.  LECTURES IN APPLIED MATHEMATICS,   *
!     *        VOL 22, AMER. MATH. SOC.; ALSO, NUMERICAL METHODS FOR   *
!     *        WEATHER PREDICTION, SEMINAR 1983, ECMWF, 103-157;       *
!     *        ALSO, SHORT- AND MEDIUM-RANGE WEATHER PREDICTION        *
!     *        RESEARCH PUBL. SER., NO. 8, WMO, GENEVA, 175-233.       *
!     *                                                                *
!     *  2.  JANJIC, Z.I., AND F. MESINGER, 1983: FINITE-DIFFERENCE    *
!     *        METHODS FOR THE SHALLOW WATER EQUATIONS ON VARIOUS      *
!     *        HORIZONTAL GRIDS.  NUMERICAL METHODS FOR WEATHER        *
!     *        PREDICTION, SEMINAR 1983, ECMWF,29-101.                 *
!     *                                                                *
!     *                     SOME  REFERENCES                           *
!     *             FOR THE PHYSICS PART OF THE MODEL                  *
!     *                                                                *
!     *  JANJIC, Z.I., 1990: THE STEP-MOUNTAIN COORDINATE:             *
!     *     PHYSICAL PACKAGE.  MONTHLY WEATHER REVIEW, VOL. 118,       *
!     *     NO. 7, 1429-1443.                                          *
!     *  JANJIC, Z.I., 1994: THE STEP MOUNTAIN ETA COORDINATE:         *
!     *     FURTHER DEVELOPMENTS OF THER CONVECTION, VISCOUS SUBLAYER, *
!     *     AND TURBULENCE CLOSURE SCHEMES.  MONTHLY WEATHER REVIEW,   *
!     *     VOL. 122, 927-945.                                         *
!     *                                                                *
!     *  ALSO SEE REFERENCES IN PHYSICAL SUBROUTINES                   *
!     *                                                                *
!     ******************************************************************

!     ******************************************************************
!     *                                                                *
!     *  THIS VERSION OF THE PROGRAM IS WRITTEN IN STANDARD ANSI       *
!     *  FORTRAN 90                                                    *
!     *                                                                *
!     *  PRINCIPAL PROGRAMMERS:                                        *
!     *                                                                *
!     *  Z. JANJIC, UNIVERSITY OF BELGRADE,                            *
!     *  T. BLACK, NCEP
!     *                                                                *
!     ******************************************************************
!     *                                                                *
!     *  THE MODEL USES THE SEMI-STAGGERED E GRID IN ARAKAWA NOTATION. *
!     *  HORIZONTAL INDEXING IS TWO-DIMENSIONAL.
!     *                                                                *
!     *                                                                *
!     *                                                                *
!     * H(1,JM)  V(1,JM)  H(2,JM)  V(2,JM) ...... V(IM-1,JM)  H(IM,JM) *
!     *    .        .        .        .               .          .     *
!     *    .        .        .        .               .          .     *
!     *    .        .        .        .               .          .     *
!     *    .        .        .        .               .          .     *
!     *                                                                *
!     * H(1,3)   V(1,3)   H(2,3)   V(2,3) ....... V(IM-1,3)   H(IM,3)  *
!     *                                                                *
!     * V(1,2)   H(1,2)   V(2,2)   H(2,2) ....... H(IM-1,2)   V(IM,2)  *
!     *                                                                *
!     * H(1,1)   V(1,1)   H(2,1)   V(2,1) ....... V(IM-1,1)   H(IM,1)  *
!     *                                                                *
!     *                                                                *
!     *                                                                *
!     *  ARRAYS ARE DIMENSIONED (IM,JM).  NOTE THAT A PHANTOM COLUMN   *
!     *  OF POINTS MUST EXIST ALONG THE EASTERN EDGE FOR THE ARRAYS    *
!     *  TO BE COMPLETE.                                               *
!     *                                                                *
!     *  THE TOTAL NUMBER OF GRID POINTS IN THE HORIZONTAL EXCLUDING   *
!     *  THE PHANTOM COLUMN IS IMJM=IM*JM-JM/2.                        *
!     *                                                                *
!     *  AUXILIARY ARRAYS ARE USED TO LOCATE NEIGHBORING GRID POINTS   *
!     *  WITH RESPECT TO A GIVEN GRID POINT.  IHE(J) IS THE INCREMENT  *
!     *  TO THE I INDEX NEEDED TO REFER TO THE V POINT EAST OF AN      *
!     *  H POINT THUS IHE(J)=0 ON ODD ROWS AND =1 ON EVEN ROWS.        *
!     *  IHW(J)=IHE(J)-1 IS THE INCREMENT TO THE INDEX OF AN H POINT   *
!     *  TO REFER TO THE V POINT TO THE WEST OF THAT H POINT.  THE     *
!     *  ANALOG EXISTS FOR THE ARRAYS IVE(J) AND IVW(J).               *
!     *                                                                *
!     *  BOUNDARY MASKS AND TOPOGRAPHY MASKS ARE DEFINED FOR VECTOR    *
!     *  PROCESSING. THE BOUNDARY MASKS HBM2(K) AND VBM2(K) ARE        *
!     *  EQUAL TO ONE EVERYWHERE EXCEPT AT THE TWO OUTERMOST ROWS      *
!     *  WHERE THEY ARE EQUAL TO ZERO. THE BOUNDARY MASK VBM3(K) IS    *
!     *  EQUAL TO ONE EVERYWHERE EXCEPT AT THE THREE OUTERMOST ROWS    *
!     *  WHERE IT IS EQUAL TO ZERO. THE TOPOGRAPHY MASKS (HTM(K,L)     *
!     *  AND VTM(K,L)) ARE SET TO ZERO UNDERNEATH THE TOPOGRAPHY AND   *
!     *  TO ONE ELSWHERE. IN ADDITION, FOR TREATMENT OF PHYSICAL       *
!     *  PROCESSES, MAXIMUM VALUES OF THE VERTICAL INDEX ARE DEFINED   *
!     *  AND STORED (LMH(K) AND LMV(K).
!     *                                                                *
!     ******************************************************************


!************************************************************************************

!      THE NUMBER OF QUILT SERVERS MUST AGREE WITH THE FOLLOWING RELATIONSHIP:

!       0 <=  NUMBER_QUILT_SERVERS <= JNPES

!       WHERE THE NUMBER_QUILT_SERVERS = ( NUMBER_OF MPI_TASKS - INPES*JNPES )

!      PREFERABLY, THE NUMBER OF QUILT SERVERS DIVIDES EVENLY INTO JNPES

!         Jim Tuccillo August 2000

!************************************************************************************

    INCLUDE 'EXCHM.h'
    LOGICAL :: &
    RUN,FIRST,RESTRT,SIGMA,NEST, CLTEND_test
!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpif.h"
    INCLUDE "mpp.h"
#include "sp.h"
!-----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
    INCLUDE "COMM_CONTIN.f90"
    INCLUDE "COMM_VRBLS.f90"
    INCLUDE "COMM_PVRBLS.f90"
    INCLUDE "COMM_NHYDRO.f90"
    INCLUDE "COMM_CLDWTR.f90"
    INCLUDE "COMM_NSOILTYPE.f90"
!-----------------------------------------------------------------------
    LOGICAL :: GSPREC
    NAMELIST /GSPRECNML/ GSPREC
!-----------------------------------------------------------------------
    LOGICAL :: SLOPE
    NAMELIST /SLOPENML/ SLOPE
!-----------------------------------------------------------------------
!***
!***  THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY
!***
    real*8 :: timef
    real :: nhb_tim,mpp_tim,init_tim
    common/timing/surfce_tim,nhb_tim,res_tim,exch_tim
! L
    character envar*4, srfile*7
! L

!-----------------------------------------------------------------------
!***
!***  INITIALIZE MPI,
!***  SETUP I/O SERVER MECHANICS AND CHECK FOR WHETHER A
!***  SUFFICIENT NUMBER OF MPI TASKS HAVE BEEN INITIATED.
!***  IF INSUFFICIENT MPI TASK HAVE BEEN INITIATED THE
!***  CODE WILL STOP IN SETUP_SERVERS
!***
    CALL SETUP_SERVERS(INPES*JNPES, &
    MYPE, &
    NPES, &
    IQUILT_GROUP, &
    INUMQ, &
    MPI_COMM_COMP, &
    MPI_COMM_INTER, &
    MPI_COMM_INTER_ARRAY)

    IF(MYPE == 0)THEN
        CALL W3TAGB('ETAFCST ',0097,0365,0060,'NP22   ')
    ENDIF

    IF(MYPE == NPES)THEN
    ! p        CALL START()
    ENDIF

!***
!***  AT THIS POINT NPES IS THE NUMBER OF MPI TASKS WORKING ON THE
!***  MODEL INTEGRATION. ALL OTHER TASKS ARE I/O SERVERS.

!***  AND AWAY WE GO !
!***
    IF(MYPE >= NPES)THEN
    
    !***  FIRE UP THE I/O SERVERS
    
        CALL QUILT
    
    ELSE
    !***
    !***  THESE ARE THE TASKS THAT DO THE MODEL INTEGRATION
    !***
    !-----------------------------------------------------------------------
        mpp_tim=   0.
    
        bocoh_tim= 0.
        bocov_tim= 0.
        chkout_tim=0.
        cltend_tim=0.
        cucnvc_tim=0.
        ddamp_tim= 0.
        divhoa_tim=0.
        exch_tim=  0.
        goss_tim=  0.
        gscond_tim=0.
        gsmdrive_tim=0.
        hdiff_tim= 0.
        hzadv_tim= 0.
        hzadv2_tim=0.
        init_tim=  0.
        nhb_tim=   0.
        pdnew_tim= 0.
        pdtedt_tim=0.
        pgcor_tim= 0.
        precpd_tim= 0.
    ! l
        pptadj_tim=0.
    ! l
        radtn_tim= 0.
        rdtemp_tim=0.
        res_tim=   0.
        surfce_tim=0.
        turbl_tim= 0.
        vtadv_tim= 0.
        vadz_tim=  0.
        hadz_tim=  0.
        eps_tim=   0.
    !-----------------------------------------------------------------------
    !***
    !***  INITIALIZE ALL QUANTITIES ASSOCIATED WITH GRID DECOMPOSITION
    !***
        btimx=timef()
        btim=timef()
        CALL MPPINIT
        mpp_tim=mpp_tim+timef()-btim
    !-----------------------------------------------------------------------
    !--------INITIALIZE CONSTANTS AND VARIABLES-----------------------------
    !--------DISTRIBUTE THE VALUES TO THE VARIOUS NODES/PEs-----------------
    !-----------------------------------------------------------------------

        IF (MYPE == 0) THEN
            write(6,*) 'lendo a QUANTIDADE DE TIPOS DE SOLO '
        ENDIF
        open(1,file='TYPSOLO',form='formatted',status='old')
        read(1,110)NSOTYP
        110 format(I2)
        close(1)
        IF (MYPE == 0) THEN
            write(6,*) 'NSOTY: ',NSOTYP
        ENDIF

        OPEN(UNIT=1,FILE='GSPREC.nml',STATUS='old')
        READ(1,GSPRECNML)
        CLOSE(1)
              
        IF (MYPE == 0) THEN
            IF (GSPREC) THEN
                write(6,*) 'UTILIZANDO: FERRIER'
            ELSE
                write(6,*) 'UTILIZANDO: ZHAO'
            ENDIF
        ENDIF

        OPEN(UNIT=9,FILE="slope.nml",STATUS="OLD")
        READ(9,SLOPENML)
        CLOSE(9)
        WRITE(*,SLOPENML)

        bbtim=timef()
        IF (SLOPE) THEN
            CALL INITS
        ELSE
            CALL INIT
        END IF
        init_tim=timef()-bbtim
    
        btim=timef()
        CALL GOSSIP
        goss_tim=goss_tim+timef()-btim
    !-----------------------------------------------------------------------
    !--------INVOKE THE LYNCH DIGITAL FILTER IF DESIRED--------------------
    !-----------------------------------------------------------------------
    !      DO NFLT=1,3
    !       IF(.NOT.NEST.AND.NFLT.GT.1.AND.MYPE.EQ.0)THEN
    !         REWIND NBC
    !         READ(NBC)
    !         READ(NBC)BCHR
    
    !      ENDIF
    !       CALL DIGFLT
    
    !      ENDDO
        CALL GETENV("tmmark",ENVAR)
    !      IF(MYPE.EQ.0) PRINT *, "EBU finds that tmmark =",ENVAR
        write(0,*) "EBU finds that tmmark =",ENVAR
        IF(ENVAR /= 'tm00') then
        ! p        write(srfile,10) envar
            10 format('SR.',a4)
        ! p        open(90,file=srfile,form='unformatted')
        ! p        CALL READPCP
        endif
    ! L
    !-----------------------------------------------------------------------
        CLTEND_test= .TRUE. 
        IF (NPHS /= NCNVC) THEN
            CLTEND_test= .FALSE. 
            IF (ENVAR /= 'tm00') THEN
                WRITE(0,"(A)") 'WARNING: RESULTS COULD BE IN ERROR !'
            !          WRITE(6,"(A)") 'WARNING: RESULTS COULD BE IN ERROR !'
            ENDIF
        ENDIF
    !-----------------------------------------------------------------------
    !-------- Special consideration when NTSD=0 at start of forecast -------
    !-----------------------------------------------------------------------
        IF (NTSD == 0) NTSD=1
    !-----------------------------------------------------------------------
    !----- Called at beginning every time in order to test cycling
    !-----------------------------------------------------------------------
          IF ( MOD(NTSD,NRADS).EQ.1 .OR. MOD(NTSD,NRADL).EQ.1 ) THEN
            btim=timef()
            CALL RADTN
            radtn_tim=radtn_tim+timef()-btim
          ENDIF
    !-----------------------------------------------------------------------
    !------------------GENERATE INITIAL OUTPUT------------------------------
    !-----------------------------------------------------------------------
        btim=timef()
        CALL CHKOUT
        chkout_tim=chkout_tim+timef()-btim
        IF (NTSD == 1) NTSD=0
    !-----------------------------------------------------------------------
    !********ENTRY INTO THE TIME LOOP***************************************
    !-----------------------------------------------------------------------
        2000 CONTINUE
        NTSD=NTSD+1
    !      IF(MYPE.EQ.0)WRITE(6,2001) NTSD,(NTSD-1)*DT,(NTSD-1)*DT/3600.
        IF(MYPE == 0)WRITE(0,2001) NTSD,(NTSD-1)*DT,(NTSD-1)*DT/3600.
        2001 FORMAT('EBU:  TIMESTEP NTSD=',I5,'  FCST TIME=',F7.0,' s', &
        ' and ',F6.3,' h')
    !-----------------------------------------------------------------------
    !***  START THE ADJUSTMENT STEP: INTEGRATE FORWARD THE CONTINUITY
    !***  EQUATION (UPDATE THE MASS FIELD)
    !-----------------------------------------------------------------------
    !***
    !***  DIVERGENCE AND HORIZONTAL PART OF THE OMEGA-ALPHA TERM
    !***
        IF(NTSD > 1)CALL EXCH(T,LM,U,LM,V,LM,Q,LM,2,2)
    
        IF( .NOT. HYDRO)THEN
            IF(NTSD > 1)CALL EXCH(DWDT,LM,PINT,LM+1,5,5)
        ENDIF
    
        btim=timef()
        IF (SLOPE) THEN
        ! LG      CALL DIVHOAS
            CALL DIVHOASTQL
!!            CALL DIVHOAST
        ELSE
            CALL DIVHOA
        END IF
        divhoa_tim=divhoa_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !--------PRESSURE TENDENCY, ETA/SIGMA DOT, VERTICAL OMEGA-ALPHA---------
    !-----------------------------------------------------------------------
    
        btim=timef()
        CALL EXCH(PD,1,DIV,LM,PINT,LM+1,2,2)
        exch_tim=exch_tim+timef()-btim
    
        btim=timef()
        CALL PDTEDT                      !Contains call to EXCH
        pdtedt_tim=pdtedt_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !--------DO VERTICAL ADVECTION WITHIN THE FIRST ADJUSTMENT STEP---------
    !-----------------------------------------------------------------------
    
        IF(MOD(NTSD-1,IDTAD) == 0)THEN
            btim=timef()
            CALL EXCH(ETADT,LM-1,1,1)
            exch_tim=exch_tim+timef()-btim
        
            btim=timef()
            CALL VTADV
            vtadv_tim=vtadv_tim+timef()-btim
        
            btim=timef()
            CALL EXCH(T,LM,U,LM,V,LM,Q,LM,Q2,LM,1,1)
            exch_tim=exch_tim+timef()-btim
        ENDIF
    
    !-----------------------------------------------------------------------
    !--------UPDATING PRESSURE DIFFERENCE-----------------------------------
    !-----------------------------------------------------------------------
    
        btim=timef()
        CALL PDNEW
        pdnew_tim=pdnew_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !--------UPDATING BOUNDARY VALUES AT HEIGHT POINTS----------------------
    !-----------------------------------------------------------------------
    
        btim=timef()
        IF(MOD(NTSD,IDTAD) == 0)THEN
            CALL EXCH(T,LM,Q,LM,Q2,LM,1,1)
        ENDIF
        CALL EXCH(PD,1,CWM,LM,1,1)
        exch_tim=exch_tim+timef()-btim
    
        btim=timef()
        CALL BOCOH
        bocoh_tim=bocoh_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !***  INTEGRATE BACKWARD THE MOMENTUM EQUATION
    !***  (UPDATE THE WIND FIELD)
    !-----------------------------------------------------------------------
    
    !***  PRESSURE GRADIENT AND CORIOLIS FORCE TERMS
    
        btim=timef()
        CALL EXCH(PD,1,T,LM,Q,LM,2,2)
    
        IF( .NOT. HYDRO)THEN
            CALL EXCH(PINT,LM+1,5,5)
        ENDIF
    
        exch_tim=exch_tim+timef()-btim
    
        btim=timef()
        CALL PGCOR
        pgcor_tim=pgcor_tim+timef()-btim
    
        btim=timef()
        CALL EXCH(PDSL,1,5,5)
        exch_tim=exch_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !--------DIVERGENCE DAMPING---------------------------------------------
    !-----------------------------------------------------------------------
    
        IF(MOD(NTSD,NTDDMP) == 0)THEN
            btim=timef()
            CALL EXCH(T,LM,U,LM,V,LM,DIV,LM,1,1)
            exch_tim=exch_tim+timef()-btim
        
            btim=timef()
            CALL DDAMP
            ddamp_tim=ddamp_tim+timef()-btim
        ENDIF
    !-----------------------------------------------------------------------
    !--------UPDATING BOUNDARY VALUES AT VELOCITY POINTS--------------------
    !-----------------------------------------------------------------------
    
        btim=timef()
        CALL EXCH(U,LM,V,LM,1,1)
        exch_tim=exch_tim+timef()-btim
    
        btim=timef()
        CALL BOCOV
        bocov_tim=bocov_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !***
    !***  THE ADJUSTMENT STEP IS NOW DONE.  MAKE THE REMAINING CALLS WHICH
    !***  TRADITIONALLY (SO FAR) HAVE BEEN DONE EVERY ADJUSTMENT STEP
    !***
    !-----------------------------------------------------------------------
    !--------APPLY TEMPERATURE TENDENCY DUE TO RADIATION--------------------
    !-----------------------------------------------------------------------
    
        btim=timef()
        CALL RDTEMP
        rdtemp_tim=rdtemp_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !--------LATERAL DIFFUSION----------------------------------------------
    !-----------------------------------------------------------------------
    
        btim=timef()
        CALL EXCH(T,LM,U,LM,V,LM,Q,LM,2,2)
        CALL EXCH(Q2,LM,1,1)
        exch_tim=exch_tim+timef()-btim
    
        btim=timef()
        IF (SLOPE) THEN
            CALL HDIFFS
        ELSE
           CALL HDIFF
        END IF
        hdiff_tim=hdiff_tim+timef()-btim
    
    !-----------------------------------------------------------------------
    !------- HORIZONTAL ADVECTION ------------------------------------------
    !-----------------------------------------------------------------------
    
        IF(MOD(NTSD,IDTAD) == 0)THEN
            btim=timef()
            CALL EXCH(T,LM,U,LM,V,LM,4,4)
            CALL EXCH(Q2,LM,5,5)
            exch_tim=exch_tim+timef()-btim
        
            btim=timef()
            IF (SLOPE) THEN
                CALL HZADVS
            ! LG        CALL SLADVT
            ELSE
                CALL HZADV
            !        CALL HZADV_LM1
            END IF
            hzadv_tim=hzadv_tim+timef()-btim
        
            btim=timef()
            CALL EXCH(U,LM,V,LM,Q,LM,CWM,LM,2,2)
            exch_tim=exch_tim+timef()-btim
        
        !***  HORIZONTAL ADVECTION OF WATER SUBSTANCE
        
            btim=timef()
            CALL HZADV2
            hzadv2_tim=hzadv2_tim+timef()-btim
        ENDIF
    !-----------------------------------------------------------------------
    
    !***  IF THE TIME IS RIGHT, NOW DO VARIOUS PHYSICS CALLS
    !***  (WARNING: TO AVOID ENDING THE INTEGRATION WITH PHYSICS CALLS
    !***  WHICH HAVE NOT BEEN FOLLOWED BY ADJUSTMENT STEPS, PHYSICS CALLS
    !***  ARE OFFSET BY HALVES OF VARIOUS CALLING INTERVALS.  IT IS
    !***  ASSUMED THAT THE CALLING INTERVALS, NPHS AND NCNVC,
    !***  ARE DIVISIBLE BY IDTAD.  IF NOT, INTEGRATION WILL END WITH AN
    !***  INCORRECT NUMBER OF CALLS HAVING BEEN MADE.
    
    !-----------------------------------------------------------------------
    !--------TURBULENT PROCESSES AND PRECIPITATION--------------------------
    !-----------------------------------------------------------------------
        IF(MOD(NTSD-NPHS/2,NPHS) == 0)THEN
                IF (MYPE.EQ.0) THEN
                  WRITE(0,"(a)") 'EBU:  Physics time step'
        !          WRITE(6,"(a)") 'EBU:  Physics time step'
                ENDIF
            btim=timef()
            CALL EXCH(PD,1,UZ0,1,VZ0,1,T,LM,U,LM,V,LM,Q,LM,1,1)
            exch_tim=exch_tim+timef()-btim
        
                btim=timef()
                CALL TURBL                     !Contains calls to EXCH
                turbl_tim=turbl_tim+timef()-btim
        !-----------------------------------------------------------------------
        !--- Store original temperature array
        !-----------------------------------------------------------------------
                IF (CLTEND_test) THEN
                  btim=timef()
                  ICLTEND=-1
                  CALL CLTEND (ICLTEND)
                  cltend_tim=cltend_tim+timef()-btim
        	       ENDIF

        	if (.not. GSPREC) then
        	btim=timef()
                CALL GSCOND
                gscond_tim=gscond_tim+timef()-btim
        	endif

        !-----------------------------------------------------------------------
        !--------CONVECTIVE PRECIPITATION---------------------------------------
        !-----------------------------------------------------------------------
                btim=timef()
        !        CALL CUCNVC
                cucnvc_tim=cucnvc_tim+timef()-btim
        !-----------------------------------------------------------------------
        !-- GRIDSCALE MICROPHYSICS (CONDENSATION & PRECIPITATION; forecast only
        !-----------------------------------------------------------------------
              if (GSPREC) then
                  btim=timef()
                  CALL GSMDRIVE
                  gsmdrive_tim=gsmdrive_tim+timef()-btim
               else

        !-----------------------------------------------------------------------
        !-- GRIDSCALE ZHAO MICROPHYSICS
        !-----------------------------------------------------------------------
                btim=timef()
                CALL PRECPD
        	precpd_tim=precpd_tim+timef()-btim
              endif
        !-----------------------------------------------------------------------
        !--------PRECIPIPTATION ASSIMILATION------------------------------------
        !-----------------------------------------------------------------------
        !        IF (ENVAR .NE. 'tm00') THEN
        !          btim=timef()
        !          CALL CHKSNOW
        !          CALL ADJPPT
        !          pptadj_tim=pptadj_tim+timef()-btim
        !        ENDIF
        !-----------------------------------------------------------------------
        !-------- Calculate temp tendencies and restore original temps ---------
        !-----------------------------------------------------------------------
                        IF (CLTEND_test) THEN
                          btim=timef()
                          ICLTEND=0
                          CALL CLTEND (ICLTEND)
                          cltend_tim=cltend_tim+timef()-btim
                        ENDIF
        !--------------------------------
        !----- End physics IF loop ------
        !--------------------------------
        ENDIF
    !-----------------------------------------------------------------------
    !----- Update temp tendencies from cloud processes every time step -----
    !-----------------------------------------------------------------------
                  IF (CLTEND_test) THEN
                    btim=timef()
                    ICLTEND=1
                    CALL CLTEND (ICLTEND)
                    cltend_tim=cltend_tim+timef()-btim
                  ENDIF
    
    !-----------------------------------------------------------------------
    !-------------------VERTICAL ADVECTION OF HEIGHT------------------------
    !-----------------------------------------------------------------------
        btim=timef()
        CALL VADZ
        vadz_tim=vadz_tim+timef()-btim
    !-----------------------------------------------------------------------
    !-------------------HORIZONTAL ADVECTION OF HEIGHT----------------------
    !-----------------------------------------------------------------------
        IF( .NOT. HYDRO)THEN
            btim=timef()
            CALL EXCH(U,LM,V,LM,1,1)
            CALL EXCH(Z,LM+1,2,2)
            exch_tim=exch_tim+timef()-btim
        ENDIF
    
        btim=timef()
        CALL HADZ
        hadz_tim=hadz_tim+timef()-btim
    !-----------------------------------------------------------------------
    !------------------------ ADVECTION OF W -------------------------------
    !-----------------------------------------------------------------------
        IF(HYDRO)THEN
            btim=timef()
            CALL EXCH(PDSL,1,2,2)
            CALL EXCH(PINT,LM+1,3,3)
            exch_tim=exch_tim+timef()-btim
        ELSE
            btim=timef()
            CALL EXCH(PDSL,1,2,2)
            CALL EXCH(U,LM,V,LM,DWDT,LM,PINT,LM+1,W,LM+1,3,3)
            exch_tim=exch_tim+timef()-btim
        ENDIF
    
        btim=timef()
        CALL EPS
        eps_tim=eps_tim+timef()-btim
        IF(NTSD > NSTART+1)THEN
        !-----------------------------------------------------------------------
        !------------------------RADIATION--------------------------------------
        !-----------------------------------------------------------------------
                IF ( MOD(NTSD,NRADS).EQ.1 .OR. MOD(NTSD,NRADL).EQ.1 ) THEN
                  btim=timef()
                  CALL RADTN
                  radtn_tim=radtn_tim+timef()-btim
                ENDIF
        !-----------------------------------------------------------------------
        !--------IS IT TIME FOR A CHECK POINT ON THE MODEL HISTORY FILE?--------
        !-----------------------------------------------------------------------
            btim=timef()
            CALL CHKOUT
            chkout_tim=chkout_tim+timef()-btim
        ENDIF
    !-----------------------------------------------------------------------
    !--------CLEAN UP AFTER RESTART-----------------------------------------
    !-----------------------------------------------------------------------
        IF(RESTRT)THEN
            RESTRT= .FALSE. 
        ENDIF
    !-----------------------------------------------------------------------
        IF(NTSD < NTSTM)GO TO 2000
    !***********************************************************************
    !**************    EXIT FROM THE TIME LOOP    **************************
    !***********************************************************************
    
        2005 continue
        tot2_tim=timef()-btimx
        tot_tim=mpp_tim+init_tim+goss_tim+radtn_tim+chkout_tim+ &
        divhoa_tim+pdtedt_tim+vtadv_tim+pdnew_tim+bocoh_tim+ &
        pgcor_tim+ddamp_tim+bocov_tim+rdtemp_tim+hdiff_tim+ &
        hzadv_tim+hzadv2_tim+turbl_tim+gscond_tim+cucnvc_tim+ &
        exch_tim+gsmdrive_tim+cltend_tim+ &
        vadz_tim+hadz_tim+eps_tim+precpd_tim
    
        if(mype == 0)then
            pct=mpp_tim/tot_tim*1.e2
            write(6,*)' mpp=',mpp_tim*1.e-3,'    pct=',pct
            pct=init_tim/tot_tim*1.e2
            write(6,*)' init=',init_tim*1.e-3,'   pct=',pct
            pct=goss_tim/tot_tim*1.e2
            write(6,*)' goss=',goss_tim*1.e-3,'   pct=',pct
            pct=radtn_tim/tot_tim*1.e2
            write(6,*)' radtn=',radtn_tim*1.e-3,'  pct=',pct
            pct=chkout_tim/tot_tim*1.e2
            write(6,*)' chkout=',chkout_tim*1.e-3,' pct=',pct
            pct=divhoa_tim/tot_tim*1.e2
            write(6,*)' divhoa=',divhoa_tim*1.e-3,' pct=',pct
            pct=pdtedt_tim/tot_tim*1.e2
            write(6,*)' pdtedt=',pdtedt_tim*1.e-3,'   pct=',pct
            pct=vtadv_tim/tot_tim*1.e2
            write(6,*)' vtadv=',vtadv_tim*1.e-3,'  pct=',pct
            pct=pdnew_tim/tot_tim*1.e2
            write(6,*)' pdnew=',pdnew_tim*1.e-3,'  pct=',pct
            pct=bocoh_tim/tot_tim*1.e2
            write(6,*)' bocoh=',bocoh_tim*1.e-3,'  pct=',pct
            pct=pgcor_tim/tot_tim*1.e2
            write(6,*)' pgcor=',pgcor_tim*1.e-3,'  pct=',pct
            pct=precpd_tim/tot_tim*1.e2
            write(6,*)' precpd=',precpd_tim*1.e-3,'  pct=',pct
            pct=ddamp_tim/tot_tim*1.e2
            write(6,*)' ddamp=',ddamp_tim*1.e-3,'  pct=',pct
            pct=bocov_tim/tot_tim*1.e2
            write(6,*)' bocov=',bocov_tim*1.e-3,'  pct=',pct
            pct=rdtemp_tim/tot_tim*1.e2
            write(6,*)' rdtemp=',rdtemp_tim*1.e-3,' pct=',pct
            pct=hdiff_tim/tot_tim*1.e2
            write(6,*)' hdiff=',hdiff_tim*1.e-3,'  pct=',pct
            pct=hzadv_tim/tot_tim*1.e2
            write(6,*)' hzadv=',hzadv_tim*1.e-3,'  pct=',pct
            pct=hzadv2_tim/tot_tim*1.e2
            write(6,*)' hzadv2=',hzadv2_tim*1.e-3,' pct=',pct
            pct=vadz_tim/tot2_tim*1.e2
            write(6,*)' vadz=',vadz_tim*1.e-3,'  pct=',pct
            pct=hadz_tim/tot2_tim*1.e2
            write(6,*)' hadz=',hadz_tim*1.e-3,'  pct=',pct
            pct=eps_tim/tot2_tim*1.e2
            write(6,*)' eps=',eps_tim*1.e-3,'  pct=',pct
            pct=turbl_tim/tot_tim*1.e2
            write(6,*)' turbl=',turbl_tim*1.e-3,'  pct=',pct
            pct=cucnvc_tim/tot_tim*1.e2
            write(6,*)' cucnvc=',cucnvc_tim*1.e-3,' pct=',pct
            pct=gsmdrive_tim/tot_tim*1.e2
            write(6,*)' gsmdrive=',gsmdrive_tim*1.e-3,' pct=',pct
            pct=cltend_tim/tot_tim*1.e2
            write(6,*)' cltend=',cltend_tim*1.e-3,' pct=',pct
            pct=exch_tim/tot_tim*1.e2
            write(6,*)' exch=',exch_tim*1.e-3,'   pct=',pct
            write(6,*)' total=',tot_tim*1.e-3
            write(6,*)' total2=',tot2_tim*1.e-3
        endif
    !----------------------------------------------------------------------
    
    !***  WE MUST NOW SHUT DOWN THE I/O SERVERS
    !***  THIS IS DONE BY SENDING A -999 TO MPI TASK 0 OF EACH SERVER GROUP
    
        IF(MYPE == 0)THEN
            DO I=1,IQUILT_GROUP
                CALL MPI_SEND(-999,1,MPI_INTEGER,0,0, &
                MPI_COMM_INTER_ARRAY(I),IER)
            ENDDO
        ENDIF
    
    !----------------------------------------------------------------------
    !----------------------------------------------------------------------
    ENDIF    !  ENDIF ON TASKS FOR MODEL INTEGRATION VS I/O SERVING
!----------------------------------------------------------------------
!----------------------------------------------------------------------

    CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)

    IF(MYPE == 0) THEN
        CALL W3TAGE('ETAFCST ')
    ENDIF

    IF(MYPE == NPES)THEN
    ! p        CALL SUMMARY()
    ENDIF

    CALL MPI_FINALIZE(IERR)
!----------------------------------------------------------------------
!----------------------------------------------------------------------
    STOP
    END PROGRAM
