SUBROUTINE CHKOUT

!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    CHKOUT      POSTS PROFILES AND OUTPUT POST DATA
!   PRGRMMR: 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


! USAGE:    CALL CHKOUT
!   INPUT ARGUMENT LIST:
!     NONE

!   OUTPUT ARGUMENT LIST:
!     NONE

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:
!     UTILITIES:

!     LIBRARY: NONE

!   COMMON BLOCKS: OUTFIL
!                  CTLBLK
!                  LOOPS
!                  MASKS
!                  MAPOT
!                  VRBLS
!                  PVRBLS
!                  DYNAMD
!                  PHYS2
!                  BOCO
!                  CNVCLD
!                  CLDWTR
!                  ACMCLD
!                  ACMCLH
!                  ACMPRE
!                  ACMRDL
!                  ACMRDS
!                  ACMSFC
!                  SOIL
!                  PRFHLD
!                  TEMPV
!                  INDX

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

!     INCLUDE/DECLARE PARAMETERS.

    INCLUDE "parmeta.f90"
    INCLUDE "parm.tbl.f90"
    INCLUDE "parmsoil.f90"
    INCLUDE "mpp.h"
    INCLUDE "mpif.h"
#include "sp.h"
!--------------------------------------------------------------------
    PARAMETER &
    (IMJM=IM*JM-JM/2,IMT=2*IM-1,JMT=JM/2+1,LB=2*IM+JM-3)
!--------------------------------------------------------------------
    PARAMETER &
    (LM1=LM-1,LP1=LM+1,JAM=6+2*(JM-10) &
    , NRLX1=250,NRLX2=100)
!--------------------------------------------------------------------
    PARAMETER &
    (CAPA=0.285896)
!--------------------------------------------------------------------

!     DECLARE VARIABLES.

!--------------------------------------------------------------------
    LOGICAL :: &
    OUTJ,      &
    RUN,FIRST,RESTRT,SIGMA,STDRD,MESO,ONHOUR,EXBC,NEST,MULTIWRITE
!--------------------------------------------------------------------
    CHARACTER(2) ::  FHR
    CHARACTER(25) ::  OUTJOB
    CHARACTER(13) :: ASSIGN
    CHARACTER(3) :: CITAG
    CHARACTER(4) ::  ASTMRK,TMYY
    CHARACTER (LEN=200) :: submit         ! chou
    CHARACTER (LEN=200) :: chmo
    CHARACTER(32) :: LABEL
    INTEGER :: LABINT(4)
    EQUIVALENCE(LABEL, LABINT)
    CHARACTER(85) :: LINE
    CHARACTER(1) ::  LINE1(85)
    CHARACTER(4) :: RESTHR
    EQUIVALENCE  (LINE,LINE1)
    INTEGER :: CHX
!--------------------------------------------------------------------
    REAL :: &
    PSLP  (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,PDS   (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,FACTR (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,SWTTC (IDIM1:IDIM2,JDIM1:JDIM2,LM) &
    ,TTND  (IDIM1:IDIM2,JDIM1:JDIM2,LM)

    INTEGER :: &
    IKNTS(0:INPES*JNPES-1),IDISP(0:INPES*JNPES-1)

    REAL,  &
    ALLOCATABLE,DIMENSION(:,:,:) :: TEMPSOIL

!--------------------------------------------------------------------
    CHARACTER FINFIL*50,DONE*10
!--------------------------------------------------------------------

!     INCLUDE COMMON BLOCKS.

!--------------------------------------------------------------------
    INCLUDE "COMM_OUTFIL.f90"
    INCLUDE "COMM_CTLBLK.f90"
    INCLUDE "COMM_LOOPS.f90"
    INCLUDE "COMM_MASKS.f90"
    INCLUDE "COMM_MAPOT.f90"
    INCLUDE "COMM_VRBLS.f90"
    INCLUDE "COMM_PVRBLS.f90"
    INCLUDE "COMM_DYNAMD.f90"
    INCLUDE "COMM_PHYS2.f90"
    INCLUDE "COMM_BOCO.f90"
    INCLUDE "COMM_CNVCLD.f90"
    INCLUDE "COMM_ACMCLD.f90"
    INCLUDE "COMM_ACMCLH.f90"
    INCLUDE "COMM_ACMPRE.f90"
    INCLUDE "COMM_ACMRDL.f90"
    INCLUDE "COMM_ACMRDS.f90"
    INCLUDE "COMM_ACMSFC.f90"
    INCLUDE "COMM_SOIL.f90"
    INCLUDE "COMM_PRFHLD.f90"
    INCLUDE "COMM_CLDWTR.f90"
    INCLUDE "COMM_INDX.f90"
    INCLUDE "COMM_CONTIN.f90"
    INCLUDE "COMM_TEMPV.f90"
    INCLUDE "COMM_BUFFER.f90"
! p
    INCLUDE "COMM_NHYDRO.f90"
! p
!--------------------------------------------------------------------
    COMMON /CUINIT/ CURAD
    LOGICAL :: CURAD
!--------------------------------------------------------------------

!     DECLARE EQUIVALENCES.

!--------------------------------------------------------------------
    EQUIVALENCE &
    (TTND (1,1,1),SWTTC(1,1,1))
!--------------------------------------------------------------------
    INTEGER :: &
    JSTAT(MPI_STATUS_SIZE)
!--------------------------------------------------------------------
    REAL(8) SUMT(LM), &
    SUMT_0(LM), &
    SUMT2(LM), &
    SUMT2_0(LM)
    REAL(8) STDEV,RMS,TMEAN
    REAL ::    TMAX(LM), TMAX_0(LM), TMIN(LM), TMIN_0(LM)
    REAL(8) STRWAIT, ENDWAIT, rtc
    INTEGER :: IHS
    DATA IHS/MPI_REQUEST_NULL/
    INTEGER :: STATUS(MPI_STATUS_SIZE)
    INTEGER :: ISERVE

    DATA ISERVE / 1 /

!--------------------------------------------------------------------
!***
!***  THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY
!***
    real*8 :: timef
    real :: nhb_tim,mpp_tim,init_tim

!Lyra GSM Max Wind
    REAL :: MAXWind,Wind,MAXWU,MAXWV
!Lyra GSM Max Wind

    common/timing/surfce_tim,nhb_tim,res_tim,exch_tim
    common/timchk/slp_tim,gath_tim,wrt_tim,prof_tim &
    ,             bcex_tim,stat_tim 

    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
!Lyra GSM Max Wind
                 MAXWU(i,j) = U10(I,J)
                 MAXWV(i,j) = V10(I,J)
                 MAXWind(I,J) = SQRT((U10(I,J)**2)+(V10(I,J)**2))
!Lyra GSM Max Wind
            ENDDO
        ENDDO
    ENDIF
!***********************************************************************
!***
!***  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
        ENDDO
    ENDDO

!Lyra GSM Max Wind
!***  UPDATE MAX WIND
!***
    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            Wind=SQRT((U10(I,J)**2)+(V10(I,J)**2))
										IF ( Wind .GT. MAXWind(I,J) ) THEN
										   MAXWU(I,J) = U10(I,J)
													MAXWV(I,J) = V10(I,J)
												 MAXWind(I,J) = Wind
          ENDIF
        ENDDO
    ENDDO
!Lyra GSM Max Wind


!***********************************************************************
!***
!***  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 FIELDS.
!     IF NOT, EXIT THIS ROUTINE.

    IF((NTSD == NSHDE) .OR. ONHOUR)GO TO 100
    IF(NSTART > 0 .AND. NSTART+1 == NSHDE .AND. &
    NTSD-1 == NSHDE)GO TO 100

!--- 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'
        ENDIF
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                CUPPT(I,J)=0.
                HTOP(I,J)=100.
                HBOT(I,J)=0.
            ENDDO
        ENDDO
        CURAD= .FALSE. 
    ENDIF

!--- End:

    RETURN

!     IT IS TIME TO WRITE TO THE PROFILE FILE AND/OR WRITE
!     TEMPORARY FILES FOR A FULL BLOWN POST.

    100 CONTINUE

! ou 21/06/2009
!      PDS IS SURFACE PRESSURE.
!      TSHLTR HOLDS THE 2M THETA, CONVERT TO TEMPERATURE.
!      TERM1 IS 2m*G/(Rd*T)

!!$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.
            ENDIF
        ENDDO
    ENDDO
          
!   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)
            ENDDO
        ENDDO
    ENDIF
         
    IF(MYPE >= NPES-INPES)THEN
        DO J=MYJE-1,MYJE
            DO I=MYIS,MYIE
            !      if (J .eq. MYJE .and. I .eq. MYIE/2) then
            !      write(6,*) 'TSHLTR initially: ', TSHLTR(I,J)
            !      write(6,*) 'TSHLTR becoming:  ', TSHLTR(I,MYJE-2)
            !      endif
                TSHLTR1(I,J)=TSHLTR1(I,MYJE-2)
                QSHLTR(I,J)=QSHLTR(I,MYJE-2)
            ENDDO
        ENDDO
    ENDIF
              
!      DO J=MYJS,MYJE
!      DO I=MYIS,MYIE
!        IF(CZMEAN(I,J).GT.0.)THEN
!          FACTR(I,J)=CZEN(I,J)/CZMEAN(I,J)
!        ELSE
!          FACTR(I,J)=0.
!        ENDIF

!      ENDDO
!      ENDDO
         
    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))

!Lyra GSM Max Wind
            Wind=SQRT((U10(I,J)**2)+(V10(I,J)**2))
										IF ( Wind .GT. MAXWind(I,J) ) THEN
										   MAXWU(I,J) = U10(I,J)
													MAXWV(I,J) = V10(I,J)
												 MAXWind(I,J) = amax1 ( Wind, MAXWind(I,J) )
          ENDIF
!Lyra GSM Max Wind

        ENDDO
    ENDDO
! ou 21/06/2009
!---------------------------------------------------------------------

!     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)GO TO 1310

!--------------------------------------------------------------------
!***
!***  COMPUTE TEMPERATURE STATISTICS
!***
!--------------------------------------------------------------------
    btim0=timef()
    DO 1100 L=1,LM
    
        TMAX(L)=-1.E6
        TMIN(L)=1.E6
        SUMT(L)=0.
        SUMT2(L)=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
                IMAX=MY_IE_LOC-1
            ELSE
                IMAX=MY_IE_LOC
            ENDIF
            DO I=MYIS,IMAX
                SUMT(L)=SUMT(L)+T(I,JJ,L)
                SUMT2(L)=SUMT2(L)+T(I,JJ,L)**2
                TMAX(L)=AMAX1(TMAX(L),T(I,JJ,L))
                TMIN(L)=AMIN1(TMIN(L),T(I,JJ,L))
            ENDDO
        ENDDO
    1100 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 L=1,LM
            TMEAN=SUMT_0(L)/DBLE(IMJM)
            STDEV=DSQRT((DBLE(IMJM)*SUMT2_0(L)-SUMT_0(L)**2)/ &
            DBLE(DBLE(IMJM)*(DBLE(IMJM-1))))
            RMS  =DSQRT(SUMT2_0(L)/DBLE(IMJM))
        ! LG          WRITE(6,1094)L,TMAX_0(L),TMIN_0(L)
        ! LG          WRITE(6,1095)TMEAN,STDEV,RMS
        ! LG 1094     FORMAT(' LAYER=',I2,' TMAX=',E13.6,' TMIN=',E13.6)
        ! LG 1095     FORMAT(9X,' TMEAN=',E13.6,' STDEV=',E13.6,
        ! LG     1              ' RMS=',E13.6)
        ENDDO
    ENDIF

    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)

! 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.
            ENDIF
        
        ENDDO
    ENDDO

!   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)
            ENDDO
        ENDDO
    ENDIF
    IF(MYPE >= NPES-INPES)THEN
        DO J=MYJE-1,MYJE
            DO I=MYIS,MYIE
            !       if (J .eq. MYJE .and. I .eq. MYIE/2) then
            !       write(6,*) 'TSHLTR initially: ', TSHLTR(I,J)
            !       write(6,*) 'TSHLTR becoming:  ', TSHLTR(I,MYJE-2)
            !       endif
                TSHLTR(I,J)=TSHLTR(I,MYJE-2)
                QSHLTR(I,J)=QSHLTR(I,MYJE-2)
            ENDDO
        ENDDO
    ENDIF

!     SWTTC IS THE CURRENT SW TEMP TENDENCIES.

! omp parallel do
    DO L=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                SWTTC(I,J,L)=RSWTT(I,J,L)*FACTR(I,J)
            ENDDO
        ENDDO
    ENDDO

!***  TTND IS THE CURRENT RAD TEMP TENDENCIES.

    DO L=1,LM
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                TTND(I,J,L)=RLWTT(I,J,L)+SWTTC(I,J,L)
            ENDDO
        ENDDO
    ENDDO
!***
!***  CREATE NAME FOR RESTART FILE.
!***
!     IF(MYPE.EQ.0)THEN

    ITAG=NTSD/TSPH+0.5
    CALL GETENV("tmmark",RESTHR)
    IF(RESTHR == '    ')THEN
        WRITE(RSTFIL,1150)ITAG
        1150 FORMAT('restrt',I6.6 &
        ,           '.quilt')
    ELSEIF(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)
    ENDIF
!***
!***  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
    ENDIF

!       BE SURE THAT THE BUFFER IF AVAILABLE

!        STRWAIT = rtc()
!        CALL MPI_WAIT(IHS,STATUS,IERR)
!        ENDWAIT = rtc() - STRWAIT

    IF(MYPE == 0)THEN
    !          IF(ENDWAIT.GE.1.)THEN
    !            PRINT*,' Appears to be wait time in CHKOUT, time = '
    !     1,            ENDWAIT
    !          ENDIF
    ENDIF

!       PLACEHOLDER FOR RECORD LENGTH
    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)
!     ENDIF
!----------------------------------------------------------------------
!***
!***  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)
    ENDIF

    CALL COAL(PD(1:MYIE,1:MYJE),MYIE*MYJE)
    CALL COAL(RES(1:MYIE,1:MYJE),MYIE*MYJE)
!----------------------------------------------------------------------

    DO L=1,LM
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((OMGALF(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
    
        CALL COAL(OMGALF(1:MYIE,1:MYJE,L),MYIE*MYJE)
    ENDDO
! rec46

    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
    ENDIF
    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)
! rec47
!----------------------------------------------------------------------

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

    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)
! CCC
! CCC
! CCC   BOUNDARY CONDITION WRITE CHANGED TO BLANK RECORD
! CCC
! CCC
    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)PDB,TB,QB,UB,VB,Q2B,CWMB
    ENDIF

    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)
! rec48
!----------------------------------------------------------------------

    DO L = 1,LM
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((T(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(T(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((Q(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(Q(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((U(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(U(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((V(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(V(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((Q2(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(Q2(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((TTND(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(TTND(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((CWM(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(CWM(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((TRAIN(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(TRAIN(1:MYIE,1:MYJE,L),MYIE*MYJE)
    
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((TCUCN(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(TCUCN(1:MYIE,1:MYJE,L),MYIE*MYJE)
    ENDDO
! rec453
!----------------------------------------------------------------------

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

! rec454
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec455
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec456
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec457
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec458
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec459
!----------------------------------------------------------------------

!--- U00, UL, & LC are no longer used & will be removed when the new cloud
!    fields are put into the restart files & 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)
    ENDIF
    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)
! rec460
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec461
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec462
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec463
!----------------------------------------------------------------------

    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)
    ENDIF
    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)
! rec464
!----------------------------------------------------------------------

    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)
    ENDIF
    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
    ENDIF
    CALL COAL(ARDSW,1)
    CALL COAL(ARDLW,1)
    CALL COAL(ASRFC,1)
    CALL COAL(AVRAIN,1)
    CALL COAL(AVCNVC,1)
! rec465

    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) &
    ! SM v100m
    ! Lyra GSM Wind stress
        ,              ((XMOMFLUX(I,J),I=1,MYIE),J=1,MYJE) &
        ,              ((YMOMFLUX(I,J),I=1,MYIE),J=1,MYJE)    
    ! Lyra GSM Wind stress    
    ENDIF
    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)
! SM v100m
! Lyra GSM Wind stress
    CALL COAL(XMOMFLUX(1:MYIE,1:MYJE),MYIE*MYJE)
    CALL COAL(YMOMFLUX(1:MYIE,1:MYJE),MYIE*MYJE)
! Lyra GSM Wind stress

! rec466
!----------------------------------------------------------------------

    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)(((SMC(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    ENDIF
    CALL COAL(SMC(1:MYIE,1:MYJE,1:NSOIL),MYIE*MYJE*NSOIL)
! rec467
!----------------------------------------------------------------------

    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((CMC(I,J),I=1,MYIE),J=1,MYJE)
    ENDIF
    CALL COAL(CMC(1:MYIE,1:MYJE),MYIE*MYJE)
! rec468
!----------------------------------------------------------------------

    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)(((STC(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    ENDIF
    CALL COAL(STC(1:MYIE,1:MYJE,1:NSOIL),MYIE*MYJE*NSOIL)
! rec469
!----------------------------------------------------------------------

    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)(((SH2O(I,J,N),I=1,MYIE),J=1,MYJE),N=1,NSOIL)
    ENDIF
    CALL COAL(SH2O(1:MYIE,1:MYJE,1:NSOIL),MYIE*MYJE*NSOIL)
! rec???
!----------------------------------------------------------------------

    IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((ALBEDO(I,J),I=1,MYIE),J=1,MYJE)
    ENDIF
    CALL COAL(ALBEDO(1:MYIE,1:MYJE),MYIE*MYJE)
! rec???
!----------------------------------------------------------------------
    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) &
!Lyra GSM Max Wind
        ,              ((MAXWU(I,J),I=1,MYIE),J=1,MYJE) &
        ,              ((MAXWV(I,J),I=1,MYIE),J=1,MYJE) &
!Lyra GSM Max Wind
        ,                ACUTIM,ARATIM,APHTIM &
        ,                NHEAT,NPHS,NCNVC,NPREC,NRDSW,NRDLW,NSRFC &
        ,                TPH0D,TLM0D,RESTRT
    ENDIF
    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)
!Lyra GSM Max Wind
    CALL COAL(MAXWU(1:MYIE,1:MYJE),MYIE*MYJE)
    CALL COAL(MAXWV(1:MYIE,1:MYJE),MYIE*MYJE)
!Lyra GSM Max Wind
    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)
! rec470
!----------------------------------------------------------------------
    DO L=1,LM
        IF(MULTIWRITE)THEN
            WRITE(LRSTRT)((RSWTT(I,J,L),I=1,MYIE),J=1,MYJE)
            WRITE(LRSTRT)((RLWTT(I,J,L),I=1,MYIE),J=1,MYJE)
        ENDIF
        CALL COAL(RSWTT(1:MYIE,1:MYJE,L),MYIE*MYJE)
        CALL COAL(RLWTT(1:MYIE,1:MYJE,L),MYIE*MYJE)
    ENDDO

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

! p
    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)
! p
! rec560
!----------------------------------------------------------------------
!     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)
        ENDIF
    
        DO I = 0, INUMQ(ISERVE) -1
            CALL PARA_RANGE(0, jnpes-1, INUMQ(ISERVE), I, ISTART, IEND)
        ! as     call para_range(0, NPES-1,inumq(iserve), i, istart, iend)
            MYPE_ROW = MYPE / INPES
        
            IF(MYPE_ROW >= ISTART .AND. MYPE_ROW <= IEND )THEN
                write(0,*)  'CALL MPI_ISEND.... ', ip,itag
                CALL MPI_ISEND &
                (BUF,IP,mpi_real,I,ITAG,MPI_COMM_INTER_ARRAY(ISERVE),IHS,IERR)
            ENDIF
        
        ENDDO
    
    !     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)
    
    ENDIF

    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
    endif
    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'
            ! SM        WRITE(FINFIL,1190)ITAG,RESTHR
            ! SM 1190   FORMAT('fcstdone',I6.6,'.',A4)
            ! SM        LFINFIL=91
            ! SM        CLOSE(LFINFIL)
            ! SM        OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER)
            ! SM        WRITE(LFINFIL)DONE
            ! SM        CLOSE(LFINFIL)

                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
                ENDDO
                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'
            ENDIF
        ENDIF
    ENDIF
!----------------------------------------------------------------------

!***  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)   GO TO 1300
        IF (NTSD == NSHDE .OR. NSTART+1 == NSHDE) GO TO 1300
        IOUT  = IOUT-1
        1300 NSHDE = ISHDE(IOUT)
    ENDIF

!***  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
            ENDDO
        ENDDO
    ENDIF

!***  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.
            ENDDO
        ENDDO
    ENDIF

!***  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 L=1,LM
            DO J=MYJS,MYJE
                DO I=MYIS,MYIE
                    TRAIN(I,J,L) = 0.
                    TCUCN(I,J,L) = 0.
                ENDDO
            ENDDO
        ENDDO
    ENDIF

!--- 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'
        ENDIF
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                CUPPT(I,J)=0.
                HTOP(I,J)=100.
                HBOT(I,J)=0.
            ENDDO
        ENDDO
        CURAD= .FALSE. 
    ENDIF

!***  RESET CONVECTIVE CLOUD TOP AND BOTTOM ARRAYS
!     (diagnostic only; these fields are not cycled & not read when TSTART=0)

    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            CNVTOP(I,J)=100.
            CNVBOT(I,J)=0.
        ENDDO
    ENDDO

!--- 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.
            ENDDO
        ENDDO
    ENDIF

!***  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.
            ENDDO
        ENDDO
    ENDIF

!***  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.
            ENDDO
        ENDDO
    ENDIF

!***  RESET THE MAX/MIN TEMPERATURE ARRAYS

    DO J=MYJS,MYJE
        DO I=MYIS,MYIE
            TLMIN(I,J)=999.
            TLMAX(I,J)=-999.

!***  RESET THE MAX WIND ARRAYS
!Lyra GSM Max Wind
            MAXWind(I,J)=0
            wind=0
!Lyra GSM Max Wind

        ENDDO
    ENDDO
    IF (MYPE == 0) THEN
        WRITE(0,"(a)") 'FINISHED CHKOUT'
        WRITE(6,"(a)") 'FINISHED CHKOUT'
    ENDIF

!     END OF ROUTINE.


    RETURN
    END SUBROUTINE CHKOUT
    SUBROUTINE COAL(A,LEN)
    INCLUDE "COMM_BUFFER.f90"
    INCLUDE 'mpif.h'
    REAL :: A(*)
    IF ( LEN < 0 ) THEN
        IP = 0
    END IF
    IF ( IP + LEN > IBUFMAX ) THEN
        PRINT *, ' IBUFMAX in COMM_BUFFER.f90m is too small, stopping'
        PRINT *, ' CHANGE IBUFMAX in parmbuf.f90 and recompile'
        CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
    ENDIF
    DO I = 1, ABS(LEN)
        IP = IP + 1
        BUF(IP) = A(I)
    ENDDO
    END SUBROUTINE COAL
    SUBROUTINE REPLACE(A,LEN,IW)
    INCLUDE "COMM_BUFFER.f90"
    REAL :: A(*)
    IPP = IW
    DO I = 1, LEN
        BUF(IPP) = A(I)
        IPP = IPP + 1
    END DO
    END SUBROUTINE REPLACE