    SUBROUTINE CHKOUT
!>-------------------------------------------------------------------------------------------------- 
!> SUBROUTINE CHKOUT
!>
!> SUBPROGRAM: CHKOUT - POSTS PROFILES AND OUTPUT POST DATA
!> PROGRAMMER: TREADON
!> ORG: W/NP2
!> DATE: 93-02-26
!
!> ABSTRACT: 
!> THIS ROUTINE POSTS PROFILE DATA AND WRITES COMMON BLOCKS TO TEMPORARY FILE FOR USE BY THE POST
!> PROCESSOR.
!> OPTIONALLY, IF RUN UNDER PSHELL THIS ROUTINE WILL SUBMIT POST JOBS AS THE MODEL RUNS.
!> THIS ROUTINE REPLACES ETA MODEL SUBROUTINE OUTMAP.
!>
!> PROGRAM HISTORY LOG:
!> 93-02-26  RUSS TREADON
!> 93-08-30  RUSS TREADON - ADDED DOCBLOC AND DIAGNOSTIC PROFILES
!> 95-03-31  T BLACK      - CONVERTED FROM 1-D TO 2-D IN HORIZONTAL
!> 95-07-31  MIKE BALDWIN - REMOVED SOUNDING DIAGNOSTICS AND BUFR
!> 96-03-13  F MESINGER   - IMPROVED REDUCTION TO SEA LEVEL (TO ACHIEVE EXACT CONSISTENCY WITH THE
!>                          MODELS HYDROSTATIC EQUATION NEXT TO MOUNTAIN SIDES)
!> 96-04-12  MIKE BALDWIN - MODIFIED SOUNDING OUTPUT
!> 96-10-31  T BLACK      - MODIFICATIONS FOR GENERATIONS OF NESTS BCS
!> 98-11-17  T BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
!> 99-05-03  T BLACK      - SLP REDUCTION, BCEX, AND PROFILES REMOVED. EACH PE WRITES ITS OWN 
!>                          MINI-RESTRT FILE
!> 00-08-01  JIM TUCCILLO - QUILT SERVER CAPABILITY ADDED
!> 00-10-11  T BLACK      - MODIFICATIONS FOR RESTART CAPABILITY
!> 18-01-15  LUCCI        - MODERNIZATION OF THE CODE, INCLUDING:
!>                          * F77 TO F90/F95
!>                          * INDENTATION & UNIFORMIZATION CODE
!>                          * REPLACEMENT OF COMMONS BLOCK FOR MODULES
!>                          * DOCUMENTATION WITH DOXYGEN
!>                          * OPENMP FUNCTIONALITY
!>
!> INPUT  ARGUMENT LIST:
!> NONE
!>
!> OUTPUT ARGUMENT LIST:
!> NONE
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> NONE
!>
!> USE MODULES: ACMCLD
!>              ACMCLH
!>              ACMPRE
!>              ACMRDL
!>              ACMRDS
!>              ACMSFC
!>              BOCO
!>              BUFFER
!>              CLDWTR
!>              CNVCLD
!>              CONTIN
!>              CTLBLK
!>              CUINIT
!>              DYNAM
!>              F77KINDS
!>              GLB_TABLE
!>              INDX
!>              LOOPS
!>              MAPOT
!>              MAPPINGS
!>              MASKS
!>              MPPCOM
!>              NHYDRO
!>              OUTFIL
!>              PARMETA
!>              PARM_TBL
!>              PHYS
!>              PRFHLD
!>              PVRBLS
!>              SOIL
!>              TEMPCOM
!>              TEMPV
!>              TIMCHK
!>              TIMMING
!>              VRBLS
!>
!> DRIVER     : EBU
!>
!> CALLS      : MPI_BARRIER
!>              MPI_COAL
!>              MPI_REDUCE
!>--------------------------------------------------------------------------------------------------
    USE ACMCLD
    USE ACMCLH
    USE ACMPRE
    USE ACMRDL
    USE ACMRDS
    USE ACMSFC
    USE BOCO
    USE BUFFER
    USE CLDWTR
    USE CNVCLD
    USE CONTIN
    USE CTLBLK
    USE CUINIT
    USE DYNAM
    USE F77KINDS
    USE GLB_TABLE
    USE INDX
    USE LOOPS
    USE MAPOT
    USE MAPPINGS
    USE MASKS
    USE MPPCOM
    USE NHYDRO
    USE OUTFIL
    USE PARMETA
    USE PARM_TBL
    USE PHYS
    USE PRFHLD
    USE PVRBLS
    USE SOIL
    USE TEMPCOM
    USE TEMPV
    USE TIMCHK
    USE TIMMING
    USE VRBLS
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!
#include "sp.h"
!
    INTEGER(KIND=I4KIND), PARAMETER  :: IMJM  = IM * JM - JM / 2 
    INTEGER(KIND=I4KIND), PARAMETER  :: IMT   = 2  * IM - 1
    INTEGER(KIND=I4KIND), PARAMETER  :: JMT   = JM / 2  + 1
    INTEGER(KIND=I4KIND), PARAMETER  :: NRLX1 = 250
    INTEGER(KIND=I4KIND), PARAMETER  :: NRLX2 = 100
!
    REAL   (KIND=R4KIND), PARAMETER  :: CAPA = 0.285896  
!------------------
! DECLARE VARIABLES
!------------------
    LOGICAL(KIND=L4KIND)                                                                        ::&
    & OUTJ    , STDRD   , MESO    , ONHOUR  , EXBC    , MULTIWRITE
!
    CHARACTER(LEN=8)                                                                            ::&
    & FHR
!
    CHARACTER(LEN=24)                                                                           ::&
    & OUTJOB
!
    CHARACTER(LEN=16)                                                                           ::&
    & ASSIGN
!
    CHARACTER(LEN=8)                                                                            ::&
    & CITAG
!
    CHARACTER(LEN=8)                                                                            ::&
    & ASTMRK  , TMYY
!
    CHARACTER(LEN=200)                                                                          ::&
    & SUBMIT ! CHOU
!
    CHARACTER(LEN=200)                                                                          ::&
    & CHMO
!
    CHARACTER(LEN=32)                                                                           ::&
    & LABEL
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & LABINT
!
    CHARACTER(LEN=88)                                                                           ::&
    & LINE
!
    CHARACTER(LEN=8)    , DIMENSION(85)                                                         ::&
    & LINE1
!
    CHARACTER(LEN=8)                                                                            ::&
    & RESTHR
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & CHX
!
    EQUIVALENCE (LABEL, LABINT)
    EQUIVALENCE (LINE , LINE1 )
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)                                   ::&
    & PSLP    , PDS     , FACTR 
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, LM)                               ::&
    & SWTTC   , TTND
!
    INTEGER(KIND=I4KIND), DIMENSION(0:INPES*JNPES-1)                                            ::&
    & IKNTS   , IDISP
!
    REAL   (KIND=R4KIND), ALLOCATABLE, DIMENSION(:,:,:)                                         ::&
    & TEMPSOIL
!
    CHARACTER(LEN=48)                                                                           ::&
    & FINFIL
!
    CHARACTER(LEN=8)                                                                            ::&
    & DONE
!---------------------
! DECLARE EQUIVALENCES
!---------------------
    EQUIVALENCE (TTND(1,1,1), SWTTC(1,1,1))
!
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & JSTAT
!
    REAL   (KIND=R8KIND), DIMENSION(LM)                                                         ::&
    & SUMT    , SUMT_0  , SUMT2   , SUMT2_0
!
    REAL   (KIND=R8KIND)                                                                        ::&
    & STDEV   , RMS     , TMEAN
!
    REAL   (KIND=R4KIND), DIMENSION(LM)                                                         ::&
    & TMAX    , TMAX_0  ,  TMIN   ,  TMIN_0
!
    REAL   (KIND=R8KIND)                                                                        ::&
    & STRWAIT , ENDWAIT , RTC
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & IHS
!
    DATA IHS /MPI_REQUEST_NULL/
!
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & STATUS
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ISERVE
!
    DATA ISERVE / 1 /
!------------------------------------------------
! THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY
!------------------------------------------------
    REAL   (KIND=R8KIND)                                                                        ::&
    & TIMEF
!
    REAL   (KIND=R4KIND)                                                                        ::&
    & MPP_TIM , INIT_TIM
!------------------------
! IMPLICIT NONE VARIABLES
!------------------------
    INTEGER(KIND=I4KIND)                                                                        ::&
    & I       , J       , NTSPH   , LLMH    , LMHK    , IHR     , JL      , JJ      , IIMAX   ,   &
    & IRTN    , ISTAT   , K       , IER     , N       , IPMAX   , IERR    , IBLOCK  , IRECLEN ,   &
    & ISTART  , IEND    , MYPE_ROW, LUNIN   , LUNOT   , IDX 
!
    REAL   (KIND=R4KIND)                                                                        ::&
    & TLL1    , TERM1   , BTIM0   , BTIMW   , DUMMY   , DIF_TIM , WRT_TIM_0
!
    REAL   (KIND=R8KIND)                                                                        ::&
    & TIMES 
!
    NAMELIST /POSTLIST/ CHMO 
    NAMELIST /POSTLIST/ SUBMIT    !CHOU
!------------------
! START CHKOUT HERE
!------------------
!--------------------------------------------------------------------------------------------------
! ON FIRST ENTRY INITIALIZE THE OUTPUT FILE TAG TO ZERO AND DO PRELIMINARY PROFILE DATA ASSIGNMENTS
!--------------------------------------------------------------------------------------------------
    IF (NTSD == 1) THEN
        ITAG = 0
!    
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                LMHK = LMH(I,J)
                TLL1 = T(I,J,LMHK)
                TLMIN(I,J) = TLL1
                TLMAX(I,J) = TLL1
            END DO
        END DO
    END IF
!--------------------------------------
! UPDATE MAX AND MIN LOWEST LAYER TEMPS
!--------------------------------------
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            LMHK = LMH(I,J)
            TLL1 = T(I,J,LMHK)
            IF (TLL1 < TLMIN(I,J)) TLMIN(I,J) = TLL1
            IF (TLL1 > TLMAX(I,J)) TLMAX(I,J) = TLL1
        END DO
    END DO
!---------------------------------------------
! FIGURE OUT JUST WHERE IN THE FORECAST WE ARE
!---------------------------------------------
    NTSPH  = INT(3600. / DT + 0.50)
    TIMES  = (NTSD - 1) * DT
    ONHOUR = .FALSE. 
!
    IF ((MOD(TIMES,3600.) == 0.) .OR. (MOD(TIMES,3600.) > 3600.-DT)) ONHOUR = .TRUE. 
!--------------------------------------------------------------------------------------------------
! IF THE CURRENT FORECAST TIME IS A FULL HOUR OR EQUALS A FULL BLOWN POST TIME THEN WRITE THE FIELD
! IF NOT, EXIT THIS ROUTINE
!--------------------------------------------------------------------------------------------------
    IF ((NTSD == NSHDE) .OR. ONHOUR) GOTO 100
    IF (NSTART > 0 .AND. NSTART+1 == NSHDE .AND.NTSD-1 == NSHDE) GOTO 100
!--------------------------------------------------------------------------------------------------
! BEGIN: INITIALIZE CONVECTIVE CLOUD FIELDS FOR RADIATION BEFORE RETURNING TO EBU (FERR. 23 JAN 02)
!--------------------------------------------------------------------------------------------------
    IF (CURAD) THEN
        IF (MYPE == 0) THEN
            WRITE(0,"(a)") 'CHKOUT: INITIALIZE CUPPT,HTOP,HBOT'
            WRITE(6,"(a)") 'CHKOUT: INITIALIZE CUPPT,HTOP,HBOT'
        END IF
!
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                CUPPT(I,J) =   0.
                 HTOP(I,J) = 100.
                 HBOT(I,J) =   0.
            END DO
        END DO
!
        CURAD = .FALSE. 
!
    END IF
!
    RETURN
!-------------------------------------------------------------------------------------------
! IT IS TIME TO WRITE TO THE PROFILE FILE AND/OR WRITE TEMPORARY FILES FOR A FULL BLOWN POST
!-------------------------------------------------------------------------------------------
100 CONTINUE
!--------------------------------------------------
! (CHOU 21 JUN 09)
! PDS IS SURFACE PRESSURE
! TSHLTR HOLDS THE 2M THETA, CONVERT TO TEMPERATURE
! TERM1 IS 2m*G/(Rd*T)
!--------------------------------------------------
!
!------- 
! OPENMP
!------- 
!
!$omp parallel do
!
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            LLMH = LMH(I,J)
            PDS(I,J) = PD(I,J) + PT
            TERM1 = -0.068283 / T(I,J,LLMH)
            PSHLTR(I,J) = PDS(I,J) * EXP(TERM1)
            TSHLTR1(I,J) = TSHLTR(I,J) * (PSHLTR(I,J) * 1.E-5) ** CAPA
                  
            IF (CZMEAN(I,J) > 0.) THEN
                FACTR(I,J) = CZEN(I,J) / CZMEAN(I,J)
            ELSE
                FACTR(I,J) = 0.
            END IF
!
        END DO
    END DO
!-------------------------------------------------------------------------------         
! MAKE SURE POST DOES NOT BLOW UP WHEN COMPUTING RH ON THE GLOBAL N/S BOUNDARIES
!-------------------------------------------------------------------------------        
    IF (MYPE < INPES) THEN
        DO J=1,2
            DO I=MYIS,MYIE
                TSHLTR1(I,J) = TSHLTR1(I,3)
                 QSHLTR(I,J) =  QSHLTR(I,3)
            END DO
        END DO
    END IF
!       
    IF (MYPE >= NPES-INPES) THEN
        DO J=MYJE-1,MYJE
            DO I=MYIS,MYIE
                TSHLTR1(I,J) = TSHLTR1(I,MYJE-2)
                 QSHLTR(I,J) =  QSHLTR(I,MYJE-2)
            END DO
        END DO
    END IF
!         
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            TLMIN(I,J) = AMIN1(TSHLTR1(I,J), TLMIN(I,J))
            TLMAX(I,J) = AMAX1(TSHLTR1(I,J), TLMAX(I,J))
        END DO
    END DO
!------------------
! SET FORECAST HOUR
!------------------
    IHR = NTSD / TSPH + 0.5
!----------------------------------------------------------------------------------------------------------------------------------- 
! IF THIS IS NOT A FULL BLOWN OUTPUT TIME, SKIP THE RESTART FILE AND POST JOB WRITES AND GO TO SECTION WHERE ACCUMULATION ARRAYS
! ARE ZEROED OUT IF NECESSARY
!-----------------------------------------------------------------------------------------------------------------------------------
    IF (NTSD /= NSHDE .AND. NSTART+1 /= NSHDE) GOTO 1310
!-------------------------------
! COMPUTE TEMPERATURE STATISTICS
!-------------------------------
    BTIM0 = TIMEF()
!
    DO 900 JL=1,LM
!    
         TMAX(JL) = -1.E6
         TMIN(JL) =  1.E6
         SUMT(JL) =  0.
        SUMT2(JL) =  0.
!    
        JJ=0
        DO J=MY_JS_GLB,MY_JE_GLB
            JJ = JJ + 1
!
            IF (MOD(J+1,2) /= 0 .AND. MY_IE_GLB == IM) THEN
                IIMAX = MY_IE_LOC - 1
            ELSE
                IIMAX = MY_IE_LOC
            END IF
!
            DO I=MYIS,IIMAX
                 SUMT(JL) =  SUMT(JL) + T(I,JJ,JL)
                SUMT2(JL) = SUMT2(JL) + T(I,JJ,JL) ** 2
                 TMAX(JL) = AMAX1(TMAX(JL), T(I,JJ,JL))
                 TMIN(JL) = AMIN1(TMIN(JL), T(I,JJ,JL))
            END DO
        END DO
!
900 END DO
!-------------
! GLOBAL STATS
!-------------
    CALL MPI_REDUCE( SUMT,  SUMT_0, LM, MPI_REAL8, MPI_SUM, 0, MPI_COMM_COMP, IRTN)
    CALL MPI_REDUCE(SUMT2, SUMT2_0, LM, MPI_REAL8, MPI_SUM, 0, MPI_COMM_COMP, IRTN)
    CALL MPI_REDUCE( TMAX,  TMAX_0, LM, MPI_REAL , MPI_MAX, 0, MPI_COMM_COMP, IRTN)
    CALL MPI_REDUCE( TMIN,  TMIN_0, LM, MPI_REAL , MPI_MIN, 0, MPI_COMM_COMP, IRTN)
!
    IF (MYPE == 0) THEN
        DO JL=1,LM
            TMEAN = SUMT_0(JL) / DBLE(IMJM)
            STDEV = DSQRT((DBLE(IMJM)*SUMT2_0(JL)-SUMT_0(JL)**2) / DBLE(DBLE(IMJM)*(DBLE(IMJM-1))))
              RMS = DSQRT(SUMT2_0(JL) / DBLE(IMJM))
        END DO
    END IF
!
    STAT_TIM = STAT_TIM + TIMEF() - BTIM0
!----------------------------------------------------------------
! WE REACH THE CODE BELOW ONLY IF IT IS A FULL BLOWN POSTING TIME
! WRITE DATA REQUIRED TO RESTART THE MODEL/INITIALIZE THE POST
!----------------------------------------------------------------
    CALL MPI_BARRIER(MPI_COMM_COMP, ISTAT)
!--------------------------------------------------
! PDS IS SURFACE PRESSURE
! TSHLTR HOLDS THE 2M THETA, CONVERT TO TEMPERATURE
! TERM1 IS 2M*G/(RD*T)
!--------------------------------------------------
!
!------- 
! OPENMP
!------- 
!
!$omp parallel do
!
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            LLMH = LMH(I,J)
            PDS(I,J) = PD(I,J) + PT
            TERM1 = -0.068283 / T(I,J,LLMH)
            PSHLTR(I,J) = PDS(I,J) * EXP(TERM1)
            TSHLTR(I,J) = TSHLTR(I,J) * (PSHLTR(I,J) * 1.E-5) ** CAPA
!
            IF (CZMEAN(I,J) > 0.) THEN
                FACTR(I,J) = CZEN(I,J) / CZMEAN(I,J)
            ELSE
                FACTR(I,J) = 0.
            END IF
!        
        END DO
    END DO
!-------------------------------------------------------------------------------
! MAKE SURE POST DOES NOT BLOW UP WHEN COMPUTING RH ON THE GLOBAL N/S BOUNDARIES
!-------------------------------------------------------------------------------
    IF (MYPE < INPES) THEN
        DO J=1,2
            DO I=MYIS,MYIE
                TSHLTR(I,J) = TSHLTR(I,3)
                QSHLTR(I,J) = QSHLTR(I,3)
            END DO
        END DO
    END IF
!
    IF (MYPE >= NPES-INPES) THEN
        DO J=MYJE-1,MYJE
            DO I=MYIS,MYIE
                TSHLTR(I,J) = TSHLTR(I,MYJE-2)
                QSHLTR(I,J) = QSHLTR(I,MYJE-2)
            END DO
        END DO
    END IF
!----------------------------------------
! SWTTC IS THE CURRENT SW TEMP TENDENCIES
!----------------------------------------
!
!------- 
! OPENMP
!------- 
!
!$omp parallel do
!
    DO K=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                SWTTC(I,J,K) = RSWTT(I,J,K) * FACTR(I,J)
            END DO
        END DO
    END DO
!----------------------------------------
! TTND IS THE CURRENT RAD TEMP TENDENCIES
!----------------------------------------
    DO K=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                TTND(I,J,K) = RLWTT(I,J,K) + SWTTC(I,J,K)
            END DO
        END DO
    END DO
!-----------------------------
! CREATE NAME FOR RESTART FILE
!-----------------------------
    ITAG = NTSD / TSPH + 0.5
!
    CALL GETENV("TMMARK",RESTHR)
!
    IF (RESTHR == '    ') THEN
        WRITE(RSTFIL,1150) ITAG
        1150 FORMAT('RESTRT',I6.6,'.quilt')
    ELSE IF (RESTHR == 'TM00' .AND. IQUILT_GROUP > 0) THEN
        WRITE(RSTFIL,1152) ITAG, MYPE
        1152 FORMAT('RESTRT',I6.6,'.',I3.3)
        MULTIWRITE = .FALSE. 
        IF (NTSD == NTSTM) MULTIWRITE = .TRUE. 
    ELSE
        MULTIWRITE = .FALSE. 
        WRITE(RSTFIL,1155) ITAG, RESTHR
        1155 FORMAT('RESTRT',I6.6,'.quilt.',A4)
    END IF
!--------------------------
! OPEN UNIT TO RESTART FILE
!--------------------------
    LRSTRT  = 8
!
    WRT_TIM = 0.
    BTIMW   = TIMEF()
    BTIM0   = TIMEF()
!
    CLOSE(LRSTRT)
!
    IF (MULTIWRITE) THEN
        OPEN (UNIT=LRSTRT, FILE=RSTFIL, FORM='UNFORMATTED', IOSTAT=IER)
        IF (IER /= 0) WRITE(LIST,*)' LRSTRT OPEN UNIT ERROR IER=',IER
    END IF
!-------------------------------------
! BE SURE THAT THE BUFFER IF AVAILABLE
!-------------------------------------
    CALL COAL(DUMMY,-1)
!----------------------------------------------------
! WRITE DATE AND TIMESTEP INFORMATION TO RESTART FILE
!----------------------------------------------------
    LABEL = 'OMEGA-ALPHA*DT/CP'
!
    IF (MULTIWRITE) WRITE(LRSTRT) RUN, IDAT, IHRST, NTSD, LABEL, ITAG
!
    CALL COAL(RUN  ,1)
    CALL COAL(IDAT ,3)
    CALL COAL(IHRST,1)
    CALL COAL(NTSD ,1)
    CALL COAL(LABEL,8)
!------------------------------
! BEGIN WRITING THE RESTRT FILE
!------------------------------
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((PD(I,J),I=1,MYIE),J=1,MYJE), ((RES(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL( PD(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(RES(1:MYIE,1:MYJE), MYIE*MYJE)
!
    DO K=1,LM
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((OMGALF(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!    
        CALL COAL(OMGALF(1:MYIE,1:MYJE,K), MYIE*MYJE)
    END DO
!
    LABEL = 'BND, PD, RES, T, Q, U, V, Q2, TTND, CWM, TRAIN, TCUCN'
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) RUN, IDAT, IHRST, NTSD, LABEL, ITAG, FIRST, IOUT, NSHDE
    END IF
!
    CALL COAL(RUN  ,1)
    CALL COAL(IDAT ,3)
    CALL COAL(IHRST,1)
    CALL COAL(NTSD ,1)
    CALL COAL(LABEL,8)
    CALL COAL(FIRST,1)
    CALL COAL(IOUT ,1)
    CALL COAL(NSHDE,1)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((PD(I,J),I=1,MYIE),J=1,MYJE),                                              &
    &                ((RES(I,J),I=1,MYIE),J=1,MYJE),                                              &
    &                ((FIS(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(PD (1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(RES(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(FIS(1:MYIE,1:MYJE), MYIE*MYJE)
!-------------------------------------------------
! BOUNDARY CONDITION WRITE CHANGED TO BLANK RECORD
!-------------------------------------------------
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) PDB, TB, QB, UB, VB, Q2B, CWMB
    END IF
!
    CALL COAL(PDB , LB*2)
    CALL COAL(TB  , LB*LM*2)
    CALL COAL(QB  , LB*LM*2)
    CALL COAL(UB  , LB*LM*2)
    CALL COAL(VB  , LB*LM*2)
    CALL COAL(Q2B , LB*LM*2)
    CALL COAL(CWMB, LB*LM*2)
!
    DO K=1,LM
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((T(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(T(1:MYIE,1:MYJE,K), MYIE*MYJE)
!  
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((Q(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(Q(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((U(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(U(1:MYIE,1:MYJE,K), MYIE*MYJE)
    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((V(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(V(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((Q2(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(Q2(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((TTND(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(TTND(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((CWM(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(CWM(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((TRAIN(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(TRAIN(1:MYIE,1:MYJE,K), MYIE*MYJE)
!    
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((TCUCN(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(TCUCN(1:MYIE,1:MYJE,K), MYIE*MYJE)
!
    END DO
!
    LABEL = 'MISC VARIABLES'
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) RUN, IDAT, IHRST, NTSD, LABEL, ITAG                                ,        &
    &                 ((RSWIN(I,J),I=1,MYIE),J=1,MYJE), ((RSWOUT(I,J),I=1,MYIE),J=1,MYJE),        &
    &                    ((TG(I,J),I=1,MYIE),J=1,MYJE),     ((Z0(I,J),I=1,MYIE),J=1,MYJE),        &
    &                  ((AKMS(I,J),I=1,MYIE),J=1,MYJE),   ((CZEN(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(RUN,  1)
    CALL COAL(IDAT, 3)
    CALL COAL(IHRST,1)
    CALL COAL(NTSD, 1)
    CALL COAL(LABEL,8)
    CALL COAL( RSWIN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(RSWOUT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    TG(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    Z0(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  AKMS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  CZEN(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((AKHS(I,J),I=1,MYIE),J=1,MYJE),  ((THS(I,J),I=1,MYIE),J=1,MYJE),           &
    &                   ((QS(I,J),I=1,MYIE),J=1,MYJE), ((TWBS(I,J),I=1,MYIE),J=1,MYJE),           &
    &                 ((QWBS(I,J),I=1,MYIE),J=1,MYJE), ((HBOT(I,J),I=1,MYIE),J=1,MYJE),           &
    &               ((CFRACL(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(  AKHS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   THS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    QS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  TWBS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  QWBS(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  HBOT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CFRACL(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((THZ0(I,J),I=1,MYIE),J=1,MYJE),  ((QZ0(I,J),I=1,MYIE),J=1,MYJE),           &
    &                  ((UZ0(I,J),I=1,MYIE),J=1,MYJE),  ((VZ0(I,J),I=1,MYIE),J=1,MYJE),           &
    &                ((USTAR(I,J),I=1,MYIE),J=1,MYJE), ((HTOP(I,J),I=1,MYIE),J=1,MYJE),           &
    &               ((CFRACM(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(  THZ0(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   QZ0(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   UZ0(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   VZ0(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( USTAR(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  HTOP(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CFRACM(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((SNO(I,J),I=1,MYIE),J=1,MYJE), ((   SI(I,J),I=1,MYIE),J=1,MYJE),           &
    &              ((CLDEFI(I,J),I=1,MYIE),J=1,MYJE), ((   RF(I,J),I=1,MYIE),J=1,MYJE),           &
    &                ((PSLP(I,J),I=1,MYIE),J=1,MYJE), ((CUPPT(I,J),I=1,MYIE),J=1,MYJE),           &
    &              ((CFRACH(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(   SNO(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    SI(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CLDEFI(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    RF(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(  PSLP(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( CUPPT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CFRACH(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((SOILTB(I,J),I=1,MYIE),J=1,MYJE), ((SFCEXC(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((SMSTAV(I,J),I=1,MYIE),J=1,MYJE), ((SMSTOT(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((GRNFLX(I,J),I=1,MYIE),J=1,MYJE), ((PCTSNO(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(SOILTB(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SFCEXC(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SMSTAV(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SMSTOT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(GRNFLX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(PCTSNO(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((RLWIN(I,J),I=1,MYIE),J=1,MYJE), ((RADOT(I,J),I=1,MYIE),J=1,MYJE),         & 
    &                ((CZMEAN(I,J),I=1,MYIE),J=1,MYJE), ((SIGT4(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL( RLWIN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( RADOT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CZMEAN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( SIGT4(1:MYIE,1:MYJE), MYIE*MYJE)
!--------------------------------------------------------------------------------------------------
! U00, UL, AND LC ARE NO LONGER USED AND WILL BE REMOVED WHEN THE NEW CLOUD FIELDS ARE PUT INTO THE 
! RESTART FILES AND THE POST (FERRIER 23 JAN 02)
!--------------------------------------------------------------------------------------------------  
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((U00(I,J),I=1,MYIE),J=1,MYJE), UL, ((LC(I,J),I=1,MYIE),J=1,MYJE),          &
    &                  ((SR(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(U00(1:MYIE,1:MYJE),MYIE*MYJE)
    CALL COAL(UL,2*LM)
    CALL COAL( LC(1:MYIE,1:MYJE),MYIE*MYJE)
    CALL COAL( SR(1:MYIE,1:MYJE),MYIE*MYJE)
!
    LABEL = 'ACCUMULATED VARIABLES'
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) RUN, IDAT, IHRST, NTSD, LABEL, ITAG,                                        &
    &                 ((PREC(I,J),I=1,MYIE),J=1,MYJE), ((ACPREC(I,J),I=1,MYIE),J=1,MYJE),         &
    &               ((ACCLIQ(I,J),I=1,MYIE),J=1,MYJE), ((CUPREC(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(RUN  ,1)
    CALL COAL(IDAT ,3)
    CALL COAL(IHRST,1)
    CALL COAL(NTSD ,1)
    CALL COAL(LABEL,8)
!
    CALL COAL(  PREC(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ACPREC(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ACCLIQ(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CUPREC(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((ACFRCV(I,J),I=1,MYIE),J=1,MYJE), ((NCFRCV(I,J),I=1,MYIE),J=1,MYJE),       & 
    &                 ((ACFRST(I,J),I=1,MYIE),J=1,MYJE), ((NCFRST(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(ACFRCV(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(NCFRCV(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ACFRST(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(NCFRST(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((ACSNOW(I,J),I=1,MYIE),J=1,MYJE), ((ACSNOM(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((SSROFF(I,J),I=1,MYIE),J=1,MYJE), ((BGROFF(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(ACSNOW(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ACSNOM(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SSROFF(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(BGROFF(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((SFCSHX(I,J),I=1,MYIE),J=1,MYJE), ((SFCLHX(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((SUBSHX(I,J),I=1,MYIE),J=1,MYJE), ((SNOPCX(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((SFCUVX(I,J),I=1,MYIE),J=1,MYJE), ((SFCEVP(I,J),I=1,MYIE),J=1,MYJE),       &
    &                 ((POTEVP(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(SFCSHX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SFCLHX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SUBSHX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SNOPCX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SFCUVX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(SFCEVP(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(POTEVP(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((ASWIN(I,J),I=1,MYIE),J=1,MYJE), ((ASWOUT(I,J),I=1,MYIE),J=1,MYJE),         &
    &                ((ASWTOA(I,J),I=1,MYIE),J=1,MYJE),  ((ALWIN(I,J),I=1,MYIE),J=1,MYJE),         &
    &                ((ALWOUT(I,J),I=1,MYIE),J=1,MYJE), ((ALWTOA(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL( ASWIN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ASWOUT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ASWTOA(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( ALWIN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ALWOUT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ALWTOA(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ARDSW, ARDLW, ASRFC, AVRAIN, AVCNVC
    END IF
!
    CALL COAL( ARDSW,1)
    CALL COAL( ARDLW,1)
    CALL COAL( ASRFC,1)
    CALL COAL(AVRAIN,1)
    CALL COAL(AVCNVC,1)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((TH10(I,J),I=1,MYIE),J=1,MYJE),    ((Q10(I,J),I=1,MYIE),J=1,MYJE),         &
    &                  ((U10(I,J),I=1,MYIE),J=1,MYJE),    ((V10(I,J),I=1,MYIE),J=1,MYJE),         &
    &               ((TSHLTR(I,J),I=1,MYIE),J=1,MYJE), ((QSHLTR(I,J),I=1,MYIE),J=1,MYJE),         &
    &               ((PSHLTR(I,J),I=1,MYIE),J=1,MYJE),                                            &
!---------
! SM V100M
!---------
    &                ((TH100(I,J),I=1,MYIE),J=1,MYJE),   ((Q100(I,J),I=1,MYIE),J=1,MYJE),         &
    &                 ((U100(I,J),I=1,MYIE),J=1,MYJE),   ((V100(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(  TH10(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   Q10(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   U10(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   V10(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(TSHLTR(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(QSHLTR(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(PSHLTR(1:MYIE,1:MYJE), MYIE*MYJE)
!---------
! SM V100M
!---------
    CALL COAL(TH100(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( Q100(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( U100(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( V100(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) (((SMC(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    END IF
!
    CALL COAL(SMC(1:MYIE,1:MYJE,1:NSOIL), MYIE*MYJE*NSOIL)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((CMC(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(CMC(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) (((STC(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    END IF
    CALL COAL(STC(1:MYIE,1:MYJE,1:NSOIL), MYIE*MYJE*NSOIL)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) (((SH2O(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    END IF
!
    CALL COAL(SH2O(1:MYIE,1:MYJE,1:NSOIL), MYIE*MYJE*NSOIL)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((ALBEDO(I,J),I=1,MYIE),J=1,MYJE)
    END IF
!
    CALL COAL(ALBEDO(1:MYIE,1:MYJE), MYIE*MYJE)
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((POTFLX(I,J),I=1,MYIE),J=1,MYJE), ((TLMIN(I,J),I=1,MYIE),J=1,MYJE),        &
    &                  ((TLMAX(I,J),I=1,MYIE),J=1,MYJE),                                          &
    &                 ACUTIM, ARATIM, APHTIM, NHEAT, NPHS, NCNVC, NPREC, NRDSW, NRDLW, NSRFC,     &
    &                 TPH0D, TLM0D, RESTRT
    END IF
!
    CALL COAL(POTFLX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( TLMIN(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL( TLMAX(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(ACUTIM,1)
    CALL COAL(ARATIM,1)
    CALL COAL(APHTIM,1)
    CALL COAL(NHEAT ,1)
    CALL COAL(NPHS  ,1)
    CALL COAL(NCNVC ,1)
    CALL COAL(NPREC ,1)
    CALL COAL(NRDSW ,1)
    CALL COAL(NRDLW ,1)
    CALL COAL(NSRFC ,1)
    CALL COAL(TPH0D ,1)
    CALL COAL(TLM0D ,1)
    CALL COAL(RESTRT,1)
!
    DO K=1,LM
        IF (MULTIWRITE) THEN
            WRITE(LRSTRT) ((RSWTT(I,J,K),I=1,MYIE),J=1,MYJE)
            WRITE(LRSTRT) ((RLWTT(I,J,K),I=1,MYIE),J=1,MYJE)
        END IF
!
        CALL COAL(RSWTT(1:MYIE,1:MYJE,K), MYIE*MYJE)
        CALL COAL(RLWTT(1:MYIE,1:MYJE,K), MYIE*MYJE)
    END DO
!
    IF (MULTIWRITE) THEN
        WRITE(LRSTRT) ((CNVBOT(I,J),I=1,MYIE),J=1,MYJE)
        WRITE(LRSTRT) ((CNVTOP(I,J),I=1,MYIE),J=1,MYJE)
        WRITE(LRSTRT) ((RSWTOA(I,J),I=1,MYIE),J=1,MYJE)
        WRITE(LRSTRT) ((RLWTOA(I,J),I=1,MYIE),J=1,MYJE)
        CLOSE(LRSTRT)
    END IF
!
    CALL COAL(CNVBOT(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(CNVTOP(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(RSWTOA(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(RLWTOA(1:MYIE,1:MYJE), MYIE*MYJE)
!
    CALL COAL(  HBM2(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(    SM(1:MYIE,1:MYJE), MYIE*MYJE)
    CALL COAL(   SPL(1:LSL),LSL)
    CALL COAL(  DETA(1:LM),LM)
    CALL COAL(PT,1)
    CALL COAL(SPLINE,1)
!------------------------------------------------------------------------------------------------
! AT THIS POINT WE HAVE ACCUMULATED ALL OF THE DATA INTO BUF
! WE WANT TO KNOW THE MAXIMUM AMOUNT ACROSS ALL MPI TASKS
! THIS IS USEFUL IN CASE WE DECIDE TO WRITE A FILE INSTEAD OF SENDING THE DATA TO THE I/O SERVERS
!------------------------------------------------------------------------------------------------
    CALL MPI_ALLREDUCE(IP, IPMAX, 1, MPI_INTEGER, MPI_MAX, MPI_COMM_COMP, IERR)
!-----------------------------------------------------------------
! IPMAX IS THE MAXIMUM NUMBER OF 4 BYTE REALS ACROSS THE MPI TASKS
! LETS COMPUTE A RECLEN THAT IS A MULTIPLE OF 2**18 BYTES
! WE WILL USE THIS WHEN OPENING THE DIRECT ACCESS FILE
!-----------------------------------------------------------------
    IBLOCK = ((IPMAX * 4) / (2 ** 18)) + 1
    IRECLEN = IBLOCK * (2 ** 18)
!------------------------------------------------------
! WE WILL PLACE THE RECLEN IN THE BEGINNING OF THE FILE
! THIS IS HANDY
!------------------------------------------------------
    CALL REPLACE(IRECLEN, 1, 1)
!------------------------------------------------------------------------
! IF WE HAVE ANY I/O SERVERS WE WILL SEND THE DATA TO THEM FOR PROCESSING
!------------------------------------------------------------------------
    IF (IQUILT_GROUP > 0) THEN
    
        IF (MYPE == 0) THEN
            CALL MPI_SEND(ITAG, 1, MPI_INTEGER, 0, 0, MPI_COMM_INTER_ARRAY(ISERVE), IERR)
        END IF
!    
        DO I=0,INUMQ(ISERVE) -1
            CALL PARA_RANGE(0, JNPES-1, INUMQ(ISERVE), I, ISTART, IEND)
            MYPE_ROW = MYPE / INPES
!        
            IF (MYPE_ROW >= ISTART .AND. MYPE_ROW <= IEND ) THEN
               IF (MYPE == 0) WRITE(0,*)  'CALL MPI_ISEND.... ', IP, ITAG
                CALL MPI_ISEND(BUF, IP, MPI_REAL, I, ITAG, MPI_COMM_INTER_ARRAY(ISERVE), IHS, IERR)
            END IF
!        
        END DO
!--------------------------------------------------------------------------------------------------    
! IN CASE WE HAVE MULTIPLE GROUPS OF I/O SERVERS, INCREMENT TO THE NEXT SERVER FOR THE NEXT OUTPUT
! TIME
!--------------------------------------------------------------------------------------------------    
        ISERVE = ISERVE + 1
        IF (ISERVE > IQUILT_GROUP) ISERVE = 1
!---------------------------------------------------------
! APPARENTLY, WE HAVE CHOSEN NOT TO SUPPLY ANY I/O SERVERS
! WE WILL WRITE A DIRECT ACCESS FILE INSTEAD
!---------------------------------------------------------   
    ELSE  
        OPEN(UNIT=LRSTRT,FILE=RSTFIL,FORM='UNFORMATTED',IOSTAT=IER,ACCESS='DIRECT',RECL=IRECLEN)
!
        IF (IER /= 0) WRITE(LIST,*)' LRSTRT OPEN UNIT ERROR IER=', IER
!    
        WRITE(LRSTRT,REC=MYPE+1) (BUF(I),I=1,IP)
        CLOSE(LRSTRT)
!    
    END IF
!
    DIF_TIM = TIMEF() - BTIM0
    WRT_TIM = WRT_TIM + DIF_TIM
!
    CALL MPI_REDUCE(WRT_TIM, WRT_TIM_0, 1, MPI_REAL, MPI_MAX, 0, MPI_COMM_COMP, IERR)
!
    IF (MYPE == 0) THEN
        WRITE(6,*)' SHIPPED OR WROTE DATA, TIME = ', WRT_TIM_0*1.E-03
    END IF
!
    CALL MPI_BARRIER(MPI_COMM_COMP, ISTAT)
!-------------------------------------------------
! SEND SIGNAL THAT ALL TASKS HAVE FINISHED WRITING
!-------------------------------------------------
!
!----------------------------------------------------------------------------
! SM - ALTERACAO FEITA PARA O IO - PARA NAO MAIS ESCREVER O FCSTDONE E OUTJOB
!----------------------------------------------------------------------------
    OUTJ = .FALSE. 
    IF (OUTJ) THEN
        IF (IQUILT_GROUP == 0) THEN
            IF (MYPE == 0) THEN
                DONE = 'DONE'
!
                REWIND(11)
                READ(11,POSTLIST)                        !CHOU
                WRITE(LIST,POSTLIST)                     !CHOU
!                
                WRITE(OUTJOB,1240) ITAG
                1240 FORMAT('OUTJOB_SPECIAL',I6.6,'.ksh')
!
                LUNIN = 67
                LUNOT = 68
                OPEN(LUNIN, FILE='OUTJOB_SPECIAL.ksh')
                OPEN(LUNOT, FILE=OUTJOB)
                1260 FORMAT(A85)
!
                REWIND(LUNIN)
                DO I=1,11
                    READ(LUNIN,1260) LINE
                    IDX = INDEX(LINE,' ') - 1
                    WRITE(LUNOT,1260) LINE
                END DO
                1261 FORMAT('HFCT=',I6.6)
                WRITE(LUNOT,1261) ITAG
!
                1250 READ(LUNIN,1260,END=1290) LINE
                WRITE(LUNOT,1260) LINE
                GO TO 1250
                1290 CONTINUE
!
                CLOSE(LUNOT)
                CLOSE(LUNIN)
!                        
                IDX    = INDEX(SUBMIT,'#') - 1
                SUBMIT = SUBMIT(1:IDX) // OUTJOB
!                         
                CHX  = INDEX(CHMO,'#') - 1
                CHMO = CHMO(1:CHX) // OUTJOB
!
                CALL SYSTEM(CHMO)
!                         
                WRITE(LIST,*) 'CHKOUT:  SUBMIT POST JOB ', SUBMIT
                CALL SYSTEM(SUBMIT)    ! NEC EQUIVALENT
!
                IF (IER /= 0) WRITE(LIST,*)' SIGNAL SENT TO FINFIL:  DONE'
            END IF
        END IF
    END IF
!------------------------------------
! RESET ACCUMULATION COUNTERS TO ZERO
!------------------------------------
    APHTIM = 0.
    ACUTIM = 0.
    ARATIM = 0.
!---------------------------------------
! POST-POSTING UPDATING AND INITIALIZING
!---------------------------------------
!
!----------------------------------------------------------------------------------------------------------------------------
!IF (NTSD.EQ.NSHDE), THEN THIS WAS ALSO A FORECAST OUTPUT TIME.  WE NEED TO INCREMENT NSHDE FOR THE NEXT FORECAST OUTPUT TIME
!----------------------------------------------------------------------------------------------------------------------------
    IF (NTSD == NSHDE .OR. NSTART+1 == NSHDE) THEN
        IOUT = IOUT + 1
        IF (.NOT. RESTRT)   GOTO 1300
        IF (NTSD == NSHDE .OR. NSTART+1 == NSHDE) GOTO 1300
        IOUT = IOUT - 1
        1300 NSHDE = ISHDE(IOUT)
    END IF
!---------------------------
! ZERO ACCUMULATOR ARRAYS
! AVERAGE CLOUD AMOUNT ARRAY
!---------------------------
    1310 CONTINUE
!
    IF (MOD(NTSD,NCLOD) < NPHS) THEN
        IF (MYPE == 0) WRITE(LIST,*)'CHKOUT: ZERO AVG CLD AMT ARRAY'
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                ACFRCV(I,J) = 0.
                NCFRCV(I,J) = 0
                ACFRST(I,J) = 0.
                NCFRST(I,J) = 0
            END DO
        END DO
    END IF
!---------------------------------------------
! TOTAL AND CONVECTIVE PRECIPITATION ARRAYS
! TOTAL SNOW AND SNOW MELT ARRAYS
! STORM SURFACE AND BASE GROUND RUN OFF ARRAYS
! PRECIPITATION TYPE ARRAY
!---------------------------------------------
    IF (MOD(NTSD,NPREC) < NCNVC) THEN
        IF(MYPE == 0) WRITE(LIST,*) 'CHKOUT: ZERO ACCUM PRECIP ARRAYS'
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                ACPREC(I,J) = 0.
                CUPREC(I,J) = 0.
                ACSNOW(I,J) = 0.
                ACSNOM(I,J) = 0.
                SSROFF(I,J) = 0.
                BGROFF(I,J) = 0.
                SFCEVP(I,J) = 0.
                POTEVP(I,J) = 0.
            END DO
        END DO
    END IF
!--------------------------------------------------
! GRID-SCALE AND CONVECTIVE (LATENT) HEATING ARRAYS
!--------------------------------------------------
    IF (MOD(NTSD,NHEAT) < NCNVC) THEN
        IF (MYPE == 0) WRITE(LIST,*) 'CHKOUT: ZERO ACCUM LATENT HEATING ARRAYS'
        AVRAIN = 0.
        AVCNVC = 0.
        DO K=1,LM
            DO J=MYJS,MYJE
                DO I=MYIS,MYIE
                    TRAIN(I,J,K) = 0.
                    TCUCN(I,J,K) = 0.
                END DO
            END DO
        END DO
    END IF
!----------------------------------------------------------------------------------------------------
! BEGIN: INITIALIZE CONVECTIVE CLOUD FIELDS FOR RADIATION BEFORE RETURNING TO EBU (FERRIER 23 JAN 02)
!----------------------------------------------------------------------------------------------------
    IF (CURAD) THEN
        IF (MYPE == 0) THEN
            WRITE(0,"(a)") 'CHKOUT: INITIALIZE CUPPT,HTOP,HBOT'
            WRITE(6,"(a)") 'CHKOUT: INITIALIZE CUPPT,HTOP,HBOT'
        END IF
!
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                CUPPT(I,J) =   0.
                HTOP(I,J)  = 100.
                HBOT(I,J)  =   0.
            END DO
        END DO
!
        CURAD = .FALSE. 
!
    END IF
!-----------------------------------------------------------------------------------------------------------------------
! RESET CONVECTIVE CLOUD TOP AND BOTTOM ARRAYS (DIAGNOSTIC ONLY; THESE FIELDS ARE NOT CYCLED AND NOT READ WHEN TSTART=0)
!-----------------------------------------------------------------------------------------------------------------------
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            CNVTOP(I,J) = 100.
            CNVBOT(I,J) =   0.
        END DO
    END DO
!----
! END
!----
!
!---------------------------
! LONG WAVE RADIATION ARRAYS
!---------------------------
    IF (MOD(NTSD,NRDLW) < NPHS) THEN
        IF (MYPE == 0) WRITE(LIST,*) 'CHKOUT: ZERO ACCUM LW RADTN ARRAYS'
        ARDLW = 0.
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                 ALWIN(I,J) = 0.
                ALWOUT(I,J) = 0.
                ALWTOA(I,J) = 0.
            END DO
        END DO
    END IF
!----------------------------
! SHORT WAVE RADIATION ARRAYS
!----------------------------
    IF (MOD(NTSD,NRDSW) < NPHS) THEN
        IF (MYPE == 0) WRITE(LIST,*) 'CHKOUT:  ZERO ACCUM SW RADTN ARRAYS'
        ARDSW = 0.
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                 ASWIN(I,J) = 0.
                ASWOUT(I,J) = 0.
                ASWTOA(I,J) = 0.
            END DO
        END DO
    END IF
!---------------------------------------------
! SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS
!---------------------------------------------
    IF (MOD(NTSD,NSRFC) < NPHS) THEN
        IF (MYPE == 0) WRITE(LIST,*) 'CHKOUT:  ZERO ACCUM SFC FLUX ARRAYS'
        ASRFC = 0.
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                SFCSHX(I,J) = 0.
                SFCLHX(I,J) = 0.
                SUBSHX(I,J) = 0.
                SNOPCX(I,J) = 0.
                SFCUVX(I,J) = 0.
                POTFLX(I,J) = 0.
            END DO
        END DO
    END IF
!-------------------------------------
! RESET THE MAX/MIN TEMPERATURE ARRAYS
!-------------------------------------
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            TLMIN(I,J) =  999.
            TLMAX(I,J) = -999.
        END DO
    END DO
!----------------------------------------------------------------
! WRITING IN A SEPARATE FILE FOR EACH MYPE AND EACH OUTPUT PERIOD
!----------------------------------------------------------------
!    IOUT = IOUT -1
!    NSHDE = ISHDE(IOUT)
!    IF (NTSD == NSHDE .OR. NSTART+1 == NSHDE) THEN
!        CALL OUT2RESTRT(ITAG)
!    ENDIF
!    IOUT = IOUT +1
!    NSHDE = ISHDE(IOUT)    
!
    IF (MYPE == 0) THEN
        WRITE(0,"(a)") 'FINISHED CHKOUT'
        WRITE(6,"(a)") 'FINISHED CHKOUT'
    END IF
!---------------
! END OF ROUTINE
!---------------
    RETURN
!
    END SUBROUTINE CHKOUT
!
!
!
    SUBROUTINE COAL(A, LEN)
!>--------------------------------------------------------------------------------------------------
!> SUBROUTINE COAL
!> 
!> SUBPROGRAM: COAL - ?????
!> PROGRAMMER: ?????          
!> ORG: W/NP22 
!> DATE: ??-??-??
!>     
!> ABSTRACT:
!> ?????
!>     
!> PROGRAM HISTORY LOG:
!> ??-??-??  ?????      - ORIGINATOR
!> 06-07-16  LUCCI      - MODERNIZATION OF THE CODE, INCLUDING:
!>                        * F77 TO F90/F95
!>                        * INDENTATION & UNIFORMIZATION CODE
!>                        * REPLACEMENT OF COMMONS BLOCK FOR MODULES
!>                        * DOCUMENTATION WITH DOXYGEN
!>                        * OPENMP FUNCTIONALITY 
!>
!> INPUT  ARGUMENT LIST:
!> A   -
!> LEN -
!>
!> OUTPUT ARGUMENT LIST:
!> NONE
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> NONE
!>   
!> CALLS : BUFFER
!>         F77KINDS
!>
!> DRIVER: CHKOUT
!>--------------------------------------------------------------------------------------------------
    USE BUFFER
    USE F77KINDS
!
    IMPLICIT NONE
!
    INCLUDE 'mpif.h'
!
    REAL   (KIND=R4KIND), DIMENSION(*)                                    , INTENT(IN)          ::&
    & A
!------------------------
! IMPLICIT NONE VARIABLES
!------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LEN       
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & IERR    , I
!
    IF (LEN < 0) THEN
        IP = 0
    END IF
!
    IF (IP + LEN > IBUFMAX) THEN
        PRINT *, ' IBUFMAX IN MODULE_BUFFER.f90 IS TOO SMALL, STOPPING'
        PRINT *, ' CHANGE IBUFMAX IN PARMBUF.f90 AND RECOMPILE'
        CALL MPI_ABORT(MPI_COMM_WORLD, 1, IERR)
    END IF
!
    DO I=1,ABS(LEN)
        IP = IP + 1
        BUF(IP) = A(I)
    END DO
!
    END SUBROUTINE COAL
!
!
!
    SUBROUTINE REPLACE(A, LEN, IW)
!>--------------------------------------------------------------------------------------------------
!> SUBROUTINE REPLACE
!> 
!> SUBPROGRAM: REPLACE - ?????
!> PROGRAMMER: ?????          
!> ORG: W/NP22 
!> DATE: ??-??-??
!>     
!> ABSTRACT:
!> ?????
!>     
!> PROGRAM HISTORY LOG:
!> ??-??-??  ?????      - ORIGINATOR
!> 06-07-16  LUCCI      - MODERNIZATION OF THE CODE, INCLUDING:
!>                        * F77 TO F90/F95
!>                        * INDENTATION & UNIFORMIZATION CODE
!>                        * REPLACEMENT OF COMMONS BLOCK FOR MODULES
!>                        * DOCUMENTATION WITH DOXYGEN
!>                        * OPENMP FUNCTIONALITY 
!>
!> INPUT  ARGUMENT LIST:
!> A   -
!> LEN -
!> IW  -
!>
!> OUTPUT ARGUMENT LIST:
!> NONE
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> NONE
!>   
!> CALLS : BUFFER
!>         F77KINDS
!>
!> DRIVER: CHKOUT
!>--------------------------------------------------------------------------------------------------
    USE BUFFER
    USE F77KINDS
!
    IMPLICIT NONE
!
    REAL   (KIND=R4KIND), DIMENSION(*)                                    , INTENT(IN)          ::&
    & A
!------------------------
! IMPLICIT NONE VARIABLES
!------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LEN     , IW        
!
    INTEGER(KIND=I4KIND)                                                                        ::&  
    & I       , IPP 
!
    IPP = IW
!
    DO I=1,LEN
        BUF(IPP) = A(I)
        IPP = IPP + 1
    END DO
!
    END SUBROUTINE REPLACE          
