                       SUBROUTINE CHKOUT
C
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .     
C SUBPROGRAM:    CHKOUT      POSTS PROFILES AND OUTPUT POST DATA
C   PRGRMMR: TREADON         ORG: W/NP2      DATE: 93-02-26       
C     
C ABSTRACT:  THIS ROUTINE POSTS PROFILE DATA AND WRITES
C   COMMON BLOCKS TO TEMPORARY FILE FOR USE BY THE POST
C   PROCESSOR.  OPTIONALLY, IF RUN UNDER PSHELL THIS
C   ROUTINE WILL SUBMIT POST JOBS AS THE MODEL RUNS.
C   THIS ROUTINE REPLACES ETA MODEL SUBROUTINE OUTMAP.
C   .     
C     
C PROGRAM HISTORY LOG:
C   93-02-26  RUSS TREADON
C   93-08-30  RUSS TREADON - ADDED DOCBLOC AND DIAGNOSTIC PROFILES.
C   95-03-31  T BLACK - CONVERTED FROM 1-D TO 2-D IN HORIZONTAL.   
C   95-07-31  MIKE BALDWIN - REMOVED SOUNDING DIAGNOSTICS AND BUFR.
C   96-03-13  F MESINGER - IMPROVED REDUCTION TO SEA LEVEL
C                          (TO ACHIEVE EXACT CONSISTENCY WITH THE 
C                           MODELS HYDROSTATIC EQUATION NEXT TO
C                           MOUNTAIN SIDES)
C   96-04-12  MIKE BALDWIN - MODIFIED SOUNDING OUTPUT
C   96-10-31  T BLACK - MODIFICATIONS FOR GENERATIONS OF NESTS BCs
C   98-11-17  T BLACK - MODIFIED FOR DISTRIBUTED MEMORY
C   99-05-03  T BLACK - SLP REDUCTION, BCEX, AND PROFILES REMOVED;
C                       EACH PE WRITES ITS OWN MINI-RESTRT FILE
C   00-08-01  JIM TUCCILLO - QUILT SERVER CAPABILITY ADDED
C   00-10-11  T BLACK - MODIFICATIONS FOR RESTART CAPABILITY 
C                
C     
C USAGE:    CALL CHKOUT
C   INPUT ARGUMENT LIST:
C     NONE     
C
C   OUTPUT ARGUMENT LIST: 
C     NONE
C     
C   OUTPUT FILES:
C     NONE
C     
C   SUBPROGRAMS CALLED:
C     UTILITIES:
C       
C     LIBRARY: NONE
C
C   COMMON BLOCKS: OUTFIL
C                  CTLBLK
C                  LOOPS
C                  MASKS
C                  MAPOT
C                  VRBLS
C                  PVRBLS
C                  DYNAMD
C                  PHYS2
C                  BOCO
C                  CNVCLD
C                  CLDWTR
C                  ACMCLD
C                  ACMCLH
C                  ACMPRE
C                  ACMRDL
C                  ACMRDS
C                  ACMSFC
C                  SOIL
C                  PRFHLD
C                  TEMPV
C                  INDX
C     
C   ATTRIBUTES:
C     LANGUAGE: FORTRAN 90
C     MACHINE : IBM SP
C$$$  
C     
C     INCLUDE/DECLARE PARAMETERS.
C     
      INCLUDE "parmeta"
      INCLUDE "parm.tbl"
      INCLUDE "parmsoil"
      INCLUDE "mpp.h"
      INCLUDE "mpif.h"
#include "sp.h"
      INCLUDE "wave.inc"
C--------------------------------------------------------------------     
                            P A R A M E T E R
     & (IMJM=IM*JM-JM/2,IMT=2*IM-1,JMT=JM/2+1,LB=2*IM+JM-3)
C--------------------------------------------------------------------     
                            P A R A M E T E R
     & (LM1=LM-1,LP1=LM+1,JAM=6+2*(JM-10)
     &, NRLX1=250,NRLX2=100)

                            P A R A M E T E R
     & (H1000=1000.E0,H1M5=1.E-5,D125=.125E0
     &, H10000=10000.E0)
C--------------------------------------------------------------------     
                            P A R A M E T E R
     & (CAPA=0.28589641)
C--------------------------------------------------------------------     

cioannis	parameter(HOUT=6.0,PRFIELDS=1.0,PRGROUND=3.0) ! ioannis

C--------------------------------------------------------------------     
C     
C     DECLARE VARIABLES.
C
C--------------------------------------------------------------------     
                            L O G I C A L
     & RUN,FIRST,RESTRT,SIGMA,STDRD,MESO,ONHOUR,EXBC,NEST,MULTIWRITE
C--------------------------------------------------------------------     
      CHARACTER*2  FHR                             
      CHARACTER*8  OUTJOB
      CHARACTER*13 ASSIGN
      CHARACTER*4  ASTMRK,TMYY
      CHARACTER*15 SUBMIT
      CHARACTER*32 LABEL
      INTEGER LABINT(4)
      EQUIVALENCE(LABEL, LABINT)
      CHARACTER*80 LINE
      CHARACTER*1  LINE1(80)
      CHARACTER*4 RESTHR
      EQUIVALENCE  (LINE,LINE1)
C--------------------------------------------------------------------     
                            R E A L
     & 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)
C
                            I N T E G E R
     & IKNTS(0:INPES*JNPES-1),IDISP(0:INPES*JNPES-1)
C
                            R E A L
     &,ALLOCATABLE,DIMENSION(:,:,:) :: TEMPSOIL
C
       REAL RWEST, REAST, RNORT, RSOUT
C--------------------------------------------------------------------     
      CHARACTER FINFIL*50,DONE*10
C-------------------  ioannis ---------------------------------------
                            L O G I C A L      
     & PRINT_INIT,PRINT_FIELDS, PRINT_GROUND, RUN_DUST
C--------------------------------------------------------------------     
C     
C     INCLUDE COMMON BLOCKS.
C
C--------------------------------------------------------------------     
      INCLUDE "FCSTPAR.comm"  ! ioannis
      INCLUDE "OUTFIL.comm"
      INCLUDE "CTLBLK.comm"
      INCLUDE "LOOPS.comm"
      INCLUDE "MASKS.comm"
      INCLUDE "MAPOT.comm"
      INCLUDE "VRBLS.comm"
      INCLUDE "PVRBLS.comm"
      INCLUDE "DYNAMD.comm"
      INCLUDE "PHYS2.comm"
      INCLUDE "BOCO.comm"
      INCLUDE "CNVCLD.comm"
      INCLUDE "ACMCLD.comm"
      INCLUDE "ACMCLH.comm"
      INCLUDE "ACMPRE.comm"
      INCLUDE "ACMRDL.comm"
      INCLUDE "ACMRDS.comm"
      INCLUDE "ACMSFC.comm"
      INCLUDE "SOIL.comm"
      INCLUDE "PRFHLD.comm"
      INCLUDE "CLDWTR.comm"
      INCLUDE "INDX.comm"
      INCLUDE "CONTIN.comm"
      INCLUDE "TEMPV.comm"
      INCLUDE "WAVES.comm"
      INCLUDE "BUFFER.comm"
Cmp
      INCLUDE "NHYDRO.comm"
Cmp
C--------------------------------------------------------------------     
C     
C     DECLARE EQUIVALENCES.
C
C--------------------------------------------------------------------     
                            E Q U I V A L E N C E
     & (TTND (1,1,1),SWTTC(1,1,1))
C--------------------------------------------------------------------     
                            I N T E G E R
     & JSTAT(MPI_STATUS_SIZE)
C--------------------------------------------------------------------     
      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)
C-------------------- ioannis -------------------------------------
       DIMENSION TSURFCE(IDIM1:IDIM2,JDIM1:JDIM2)
     &,      T2M(IDIM1:IDIM2,JDIM1:JDIM2),SEAG(IDIM1:IDIM2,JDIM1:JDIM2)
     &,      OMG(IDIM1:IDIM2,JDIM1:JDIM2,LM)
C------------------------------------------------------------------     
      REAL(8) STRWAIT, ENDWAIT, rtc
      INTEGER IHS
      DATA IHS/MPI_REQUEST_NULL/
      INTEGER STATUS(MPI_STATUS_SIZE)
      INTEGER ISERVE
C
      DATA ISERVE / 1 /
C
C--------------------------------------------------------------------     
C***
C***  THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY
C***
      real*8 timef
      real nhb_tim,mpp_tim,init_tim
      common/timing/surfce_tim,nhb_tim,res_tim,exch_tim
      common/timchk/slp_tim,gath_tim,wrt_tim,prof_tim
     1,             bcex_tim,stat_tim
C***********************************************************************
C     START CHKOUT HERE.
C***********************************************************************
C***
C***  ON FIRST ENTRY INITIALIZE THE OUTPUT FILE TAG TO ZERO
C***  AND DO PRELIMINARY PROFILE DATA ASSIGNMENTS 
C***  
      IF((RESTRT.OR.NTSD.EQ.1).AND.NTSD.NE.0)THEN !ioannis
cioannis      IF(NTSD.EQ.1)THEN
        ITAG=0
C
        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
        ENDDO
        ENDDO
      ENDIF
C***********************************************************************
C***
C***  UPDATE MAX AND MIN LOWEST LAYER TEMPS 
C***
      DO J=MYJS,MYJE
      DO I=MYIS,MYIE
        LMHK=LMH(I,J)
        TLL1=T(I,J,LMHK)
        IF(TLL1.LT.TLMIN(I,J))TLMIN(I,J)=TLL1
        IF(TLL1.GT.TLMAX(I,J))TLMAX(I,J)=TLL1
      ENDDO
      ENDDO
C***********************************************************************
C***
C***  FIGURE OUT JUST WHERE IN THE FORECAST WE ARE.
C***
cioannisin
c      if (mype.eq.0) then
c      do j=myje,1,-1
c       write(60+MYPE,'(I2,50(F2.0))') j,(sm(i,j),i=1,myie)
c      enddo
c      endif
cc      write(6,*)'nonhydro...MYPE:',MYPE,MYIS,MYIE,MYJS,MYJE
c            if ((mype.eq.19).and.(ntsd.lt.200)) then
c        write(6,*)'ioannis..nonhydro..chkout:',MYPE,NTSD
c     $              ,fis(48,10),sm(48,10),SST(48,10)
c     $  ,LMH(48,10),LMV(48,10),HTM(48,10,38),VTM(48,10,38)
c             endif      
cioannisout

cio	NHOUT=INT(HOUT*TSPH+0.5)         ! ioannis 
cio	NPFIELDS=INT(PRFIELDS*TSPH+0.5)  ! ioannis
cio	NPGROUND=INT(PRGROUND*TSPH+0.5)  ! ioannis
cio	NPWAM=INT(PRWAM*TSPH+0.5)        ! wam

      MINNTSD = MIN(NPFIELDS,NHOUT)   ! ioannis Compute the minimum 
c                                      !timestep for output
      MINNTSD = MIN(MINNTSD,NPGROUND)  ! ioannis
cpk
!      IF (COUPLE_WAVE) MINNTSD = MIN(MINNTSD,INT(DT_WAVE_RATIO))  ! wave couple
!work      IF (MOD(NTSD,MINNTSD).EQ.0) THEN  ! ioannis
!      IF (NTSD.EQ.0 .AND. MOD(NTSD,MINNTSD).EQ.0) THEN  ! ioannis
      if(mype.eq.0) write(6,*)'ETA CHKOUT TIMESTEP: ', ntsd
!      IF(NTSD.EQ.1 .OR. MOD(NTSD,20).EQ.1) THEN  ! hardwired for wam
!work         GOTO 100                      ! ioannis
!work      ELSE                             ! ioannis 
!work         RETURN                        ! ioannis  
!work      ENDIF                            ! ioannis 
C
cioannis      NTSPH=INT(3600./DT+0.50)
cioannis      TIMES=(NTSD-1)*DT
cioannis      ONHOUR=.FALSE.
cioannis      IF((MOD(TIMES,3600.).EQ.0.).OR.
cioannis     1   (MOD(TIMES,3600.).GT.3600.-DT))ONHOUR=.TRUE.
C------------------------------------------------------------------
C
C     IF THE CURRENT FORECAST TIME IS A FULL HOUR OR EQUALS
C     A FULL BLOWN POST TIME, THEN WRITE THE FIELDS.
C     IF NOT, EXIT THIS ROUTINE.
C
cioannis      IF((NTSD.EQ.NSHDE).OR.ONHOUR)GO TO 100
cioannis      IF(NSTART.GT.0.AND.NSTART+1.EQ.NSHDE.AND.
cioannis     1   NTSD-1.EQ.NSHDE)GO TO 100
C
cioannis      RETURN
C
C     IT IS TIME TO WRITE TO THE PROFILE FILE AND/OR WRITE
C     TEMPORARY FILES FOR A FULL BLOWN POST.
C     
  100 CONTINUE
C---------------------------------------------------------------------
C
C     SET FORECAST HOUR.
C
      IHR=NTSD/TSPH+0.5
C--------------------------------------------------------------------
C***  IF THIS IS NOT A FULL BLOWN OUTPUT TIME,
C***  SKIP THE RESTART FILE AND POST JOB WRITES AND GO TO SECTION
C***  WHERE ACCUMULATION ARRAYS ARE ZEROED OUT IF NECESSARY.
C--------------------------------------------------------------------
C
cioannis      IF(NTSD.NE.NSHDE.AND.NSTART+1.NE.NSHDE)GO TO 1310
C     
C--------------------------------------------------------------------
C***
C***  COMPUTE TEMPERATURE STATISTICS
C***
C--------------------------------------------------------------------
cioannis      btim0=timef()
cioannis      DO 1100 L=1,LM
C
cioannis      TMAX(L)=-1.E6
cioannis      TMIN(L)=1.E6
cioannis      SUMT(L)=0.
cioannis      SUMT2(L)=0.
C
cioannis      JJ=0
cioannis      DO J=MY_JS_GLB,MY_JE_GLB
cioannis        JJ=JJ+1
cioannis        IF(MOD(J+1,2).NE.0.and.MY_IE_GLB.EQ.IM)THEN
cioannis          IMAX=MY_IE_LOC-1
cioannis        ELSE
cioannis          IMAX=MY_IE_LOC
cioannis        ENDIF
cioannis        DO I=MYIS,IMAX
cioannis          SUMT(L)=SUMT(L)+T(I,JJ,L) 
cioannis          SUMT2(L)=SUMT2(L)+T(I,JJ,L)**2
cioannis          TMAX(L)=AMAX1(TMAX(L),T(I,JJ,L))
cioannis          TMIN(L)=AMIN1(TMIN(L),T(I,JJ,L))
cioannis        ENDDO
cioannis      ENDDO
cioannis1100  CONTINUE
C
C***  GLOBAL STATS
C
cioannis       CALL MPI_REDUCE(SUMT,SUMT_0,LM,MPI_REAL8,MPI_SUM,0,
cioannis     1        MPI_COMM_COMP,IRTN)
cioannis       CALL MPI_REDUCE(SUMT2,SUMT2_0,LM,MPI_REAL8,MPI_SUM,0,
cioannis     1        MPI_COMM_COMP,IRTN)
cioannis       CALL MPI_REDUCE(TMAX,TMAX_0,LM,MPI_REAL,MPI_MAX,0,
cioannis     1        MPI_COMM_COMP,IRTN)
cioannis       CALL MPI_REDUCE(TMIN,TMIN_0,LM,MPI_REAL,MPI_MIN,0,
cioannis     1        MPI_COMM_COMP,IRTN)
C
C
cioannis      IF(MYPE.EQ.0)THEN
cioannis        DO L=1,LM
cioannis          TMEAN=SUMT_0(L)/DBLE(IMJM)
cioannis          STDEV=DSQRT((DBLE(IMJM)*SUMT2_0(L)-SUMT_0(L)**2)/
cioannis     1                 DBLE(DBLE(IMJM)*(DBLE(IMJM-1))))
cioannis          RMS  =DSQRT(SUMT2_0(L)/DBLE(IMJM))
cioannis          WRITE(6,1094)L,TMAX_0(L),TMIN_0(L)
cioannis          WRITE(6,1095)TMEAN,STDEV,RMS
cioannis 1094     FORMAT(' LAYER=',I2,' TMAX=',E13.6,' TMIN=',E13.6)
cioannis 1095     FORMAT(9X,' TMEAN=',E13.6,' STDEV=',E13.6,
cioannis     1              ' RMS=',E13.6)
cioannis        ENDDO
cioannis      ENDIF
C
cioannis      stat_tim=stat_tim+timef()-btim0
C
C----------------------------------------------------------------------
C***  WE REACH THE CODE BELOW ONLY IF IT IS A FULL BLOWN POSTING TIME.
C***  WRITE DATA REQUIRED TO RESTART THE MODEL/INITIALIZE THE POST.
C----------------------------------------------------------------------
      CALL MPI_BARRIER(MPI_COMM_COMP,ISTAT)
C
C     PDS IS SURFACE PRESSURE.
C     TSHLTR HOLDS THE 2M THETA, CONVERT TO TEMPERATURE.
C     TERM1 IS 2m*G/(Rd*T)
C
!$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
C
        IF(CZMEAN(I,J).GT.0.)THEN
          FACTR(I,J)=CZEN(I,J)/CZMEAN(I,J)
        ELSE
          FACTR(I,J)=0.
        ENDIF
C
      ENDDO
      ENDDO
C
C   MAKE SURE POST DOES NOT BLOW UP WHEN COMPUTING RH 
C   ON THE GLOBAL N/S BOUNDARIES
C
      IF(MYPE.LT.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.GE.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
C
C     SWTTC IS THE CURRENT SW TEMP TENDENCIES.
C
!$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
C
C***  TTND IS THE CURRENT RAD TEMP TENDENCIES.
C
      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
C
C***  2m Temperature Calculation /// omega Calculation
C
cpk      DO J=MYJS,MYJE
cpk      DO I=MYIS,MYIE
cpk        T2M(I,J)=TSHLTR(I,J)/(((PD(I,J)+PT)/100000.E0)**(-.2858964143E0)
cpk      ENDDO
cpk      ENDDO
C
cpk      DO L=1,LM
cpk        DO J=MYJS,MYJE
cpk        DO I=MYIS,MYIE
cpk          OMG(I,J,L)=OMGALF(I,J,L)*1004.6E0/(9.81*DT)
cpk        ENDDO
cpk        ENDDO
cpk      ENDDO
C
cpk      DO J=MYJS,MYJE
cpk      DO I=MYIS,MYIE
cpk        TSURFCE(I,J)=THS(I,J)*((PD(I,J)+PT2)*H1M5)**CAPA
cpk      ENDDO
cpk      ENDDO
C***
C***  CREATE NAME FOR RESTART FILE.
C***
c     IF(MYPE.EQ.0)THEN
C
cioannis        ITAG=NTSD/TSPH+0.5
cioannis        CALL GETENV("tmmark",RESTHR)
cioannis        IF(RESTHR.EQ.'    ')THEN
cioannis          WRITE(RSTFIL,1150)ITAG
cioannis 1150     FORMAT('restrt',I3.3
cioannis     1,           '.quilt')
cioannis	ELSEIF(RESTHR.EQ.'tm00'.AND.IQUILT_GROUP.GT.0)THEN
cioannis          WRITE(RSTFIL,1152)ITAG,MYPE
cioannis 1152     FORMAT('restrt',I3.3
cioannis     1,           '.',I3.3)
cioannis          MULTIWRITE=.FALSE.
cioannis          IF(NTSD.EQ.NTSTM)MULTIWRITE=.TRUE.
cioannis        ELSE
cioannis	  MULTIWRITE=.FALSE.
cioannis          WRITE(RSTFIL,1155)ITAG,RESTHR
cioannis 1155     FORMAT('restrt',I3.3
cioannis     1,           '.quilt.',a4)
cioannis        ENDIF
C***
C***  OPEN UNIT TO RESTART FILE.
C***
        LRSTRT=8
c
cioannis        wrt_tim=0.
cioannis        btimw=timef()
cioannis        btim0=timef()
c
        CLOSE(LRSTRT)
C
        MULTIWRITE=.FALSE.  ! ioannis
        IF(MULTIWRITE)THEN
          OPEN(UNIT=LRSTRT,FILE=RSTFIL,FORM='UNFORMATTED',IOSTAT=IER)
          IF(IER.NE.0)WRITE(LIST,*)' LRSTRT OPEN UNIT ERROR IER=',IER
        ENDIF
C
C       BE SURE THAT THE BUFFER IF AVAILABLE
C
C        STRWAIT = rtc()
        CALL MPI_WAIT(IHS,STATUS,IERR) ! ioannis
C        CALL MPI_WAIT(IHS,STATUS,IERR)
C        ENDWAIT = rtc() - STRWAIT
C
        IF(MYPE.EQ.0)THEN
C          IF(ENDWAIT.GE.1.)THEN
C            PRINT*,' Appears to be wait time in CHKOUT, time = '
C     1,            ENDWAIT
C          ENDIF
        ENDIF
C
C       PLACEHOLDER FOR RECORD LENGTH
        CALL COAL(DUMMY,-1)
C***
C***  WRITE DATE AND TIMESTEP INFORMATION TO RESTART FILE.
C***
c------------------ ioannis ------------------
        LABEL='D A T   FILES meteo fields'
        call coal(IDAT,3)
        call coal(IHRST,1)
        call coal(IHR,1)
        call coal(NTSD,1)
        call coal(NHOUT,1) ! ioannis give value
        call coal(LABEL,8)
c---------------------------------------------
        IF(MULTIWRITE) THEN  ! IOANNIS...CLOSE STANDARD WRITING	

        LABEL='OMEGA-ALPHA*DT/CP'
C
        IF(MULTIWRITE)
     1  WRITE(LRSTRT)RUN,IDAT,IHRST,NTSD,LABEL
C
        CALL COAL(RUN,1)
        CALL COAL(IDAT,3)
        CALL COAL(IHRST,1)
        CALL COAL(NTSD,1)
        CALL COAL(LABEL,8)
c     ENDIF
C----------------------------------------------------------------------
C***
C***  BEGIN WRITING THE RESTRT FILE
C***
chello1
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((PD(I,J),I=1,MYIE),J=1,MYJE)
     1,            ((RES(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
C
      CALL COAL(PD(1:MYIE,1:MYJE),MYIE*MYJE)
      CALL COAL(RES(1:MYIE,1:MYJE),MYIE*MYJE)
C----------------------------------------------------------------------
C
      DO L=1,LM
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((OMGALF(I,J,L),I=1,MYIE),J=1,MYJE)
      ENDIF
C
      CALL COAL(OMGALF(1:MYIE,1:MYJE,L),MYIE*MYJE)
      ENDDO
c rec46
C
      LABEL = 'BND,PD,RES,T,Q,U,V,Q2,TTND,CWM,TRAIN,TCUCN'
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)RUN,IDAT,IHRST,NTSD,LABEL
     1,              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)
c rec47
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((PD(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((RES(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((FIS(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
C
      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)
CCCCC
CCCCC
CCCCC   BOUNDARY CONDITION WRITE CHANGED TO BLANK RECORD
CCCCC
CCCCC
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)PDB,TB,QB,UB,VB,Q2B,CWMB
      ENDIF
C
      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)
c rec48
C----------------------------------------------------------------------
C
      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)
C
      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)
C
      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)
C
      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)
C
      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)
C
      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)
C
      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)
C
      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)
C
      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
c rec453
C----------------------------------------------------------------------
C
      LABEL = 'MISC VARIABLES'
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)RUN,IDAT,IHRST,NTSD,LABEL
     1,              ((RSWIN(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((RSWOUT(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((TG(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((Z0(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((AKMS(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((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)

c rec454
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((AKHS(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((THS(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((QS(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((TWBS(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((QWBS(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((CNVBOT(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((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(CNVBOT(1:MYIE,1:MYJE),MYIE*MYJE)
      CALL COAL(CFRACL(1:MYIE,1:MYJE),MYIE*MYJE)
c rec455
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((THZ0(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((QZ0(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((UZ0(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((VZ0(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((USTAR(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((CNVTOP(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((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(CNVTOP(1:MYIE,1:MYJE),MYIE*MYJE)
      CALL COAL(CFRACM(1:MYIE,1:MYJE),MYIE*MYJE)
c rec456
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((SNO(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((SI(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((CLDEFI(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((RF(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((PSLP(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((CUPPT(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((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)
c rec457
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((SOILTB(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((SFCEXC(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((SMSTAV(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((SMSTOT(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((GRNFLX(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((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)
c rec458
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((RLWIN(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((RADOT(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((CZMEAN(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((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)
c rec459
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((U00(I,J),I=1,MYIE),J=1,MYJE)
     1,                UL
     2,              ((LC(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((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)
c rec460
C----------------------------------------------------------------------
C
      LABEL = 'ACCUMULATED VARIABLES'
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)RUN,IDAT,IHRST,NTSD,LABEL
     1,            ((PREC(I,J),I=1,MYIE),J=1,MYJE)
     2,            ((ACPREC(I,J),I=1,MYIE),J=1,MYJE)
     3,            ((ACCLIQ(I,J),I=1,MYIE),J=1,MYJE)
     4,            ((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)
c rec461
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((ACFRCV(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((NCFRCV(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((ACFRST(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((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)
c rec462
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((ACSNOW(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((ACSNOM(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((SSROFF(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((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)
c rec463
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((SFCSHX(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((SFCLHX(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((SUBSHX(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((SNOPCX(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((SFCUVX(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((SFCEVP(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((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)
c rec464
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((ASWIN(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((ASWOUT(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((ASWTOA(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((ALWIN(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((ALWOUT(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((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)
C
      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)
c rec465
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((TH10(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((Q10(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((U10(I,J),I=1,MYIE),J=1,MYJE)
     3,              ((V10(I,J),I=1,MYIE),J=1,MYJE)
     4,              ((TSHLTR(I,J),I=1,MYIE),J=1,MYJE)
     5,              ((QSHLTR(I,J),I=1,MYIE),J=1,MYJE)
     6,              ((PSHLTR(I,J),I=1,MYIE),J=1,MYJE)
      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)
c rec466
C----------------------------------------------------------------------
C
      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)
c rec467
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((CMC(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
      CALL COAL(CMC(1:MYIE,1:MYJE),MYIE*MYJE)
c rec468
C----------------------------------------------------------------------
C
      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)
c rec469
C----------------------------------------------------------------------
C
      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)
c rec???
C----------------------------------------------------------------------
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((ALBEDO(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
      CALL COAL(ALBEDO(1:MYIE,1:MYJE),MYIE*MYJE)
c rec???
C----------------------------------------------------------------------
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((POTFLX(I,J),I=1,MYIE),J=1,MYJE)
     1,              ((TLMIN(I,J),I=1,MYIE),J=1,MYJE)
     2,              ((TLMAX(I,J),I=1,MYIE),J=1,MYJE)
     3,                ACUTIM,ARATIM,APHTIM
     4,                NHEAT,NPHS,NCNVC,NPREC,NRDSW,NRDLW,NSRFC
     5,                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)
      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)
c rec470
C----------------------------------------------------------------------
      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
C
      DO L=1,LM
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((T0(I,J,L),I=1,MYIE),J=1,MYJE)
        WRITE(LRSTRT)((Q0(I,J,L),I=1,MYIE),J=1,MYJE)
      ENDIF
        CALL COAL(T0(1:MYIE,1:MYJE,L),MYIE*MYJE)
        CALL COAL(Q0(1:MYIE,1:MYJE,L),MYIE*MYJE)
      ENDDO
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((P0(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
      CALL COAL(P0(1:MYIE,1:MYJE),MYIE*MYJE)
C
      IF(MULTIWRITE)THEN
        WRITE(LRSTRT)((HBOT(I,J),I=1,MYIE),J=1,MYJE)
        WRITE(LRSTRT)((HTOP(I,J),I=1,MYIE),J=1,MYJE)
      ENDIF
      CALL COAL(HBOT(1:MYIE,1:MYJE),MYIE*MYJE)
      CALL COAL(HTOP(1:MYIE,1:MYJE),MYIE*MYJE)
C
      IF(MULTIWRITE)THEN
        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(RSWTOA(1:MYIE,1:MYJE),MYIE*MYJE)
      CALL COAL(RLWTOA(1:MYIE,1:MYJE),MYIE*MYJE)
Cmp
      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)
Cmp
c rec560
      ENDIF  ! IOANNIS.....  CLOSE STANDARD WRITING

C ---------- IOANNIS ....WRITE OUTPUT SIMILARLY TO AURORA-----
C
      call coal(PD(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
      DO L = 1, LM
         call coal(T(1:myie,1:myje,l),myie*myje)
C
         call coal(Q(1:myie,1:myje,l),myie*myje)
C
         call coal(U(1:myie,1:myje,l),myie*myje)
C
         call coal(V(1:myie,1:myje,l),myie*myje)
C
         call coal(CWM(1:myie,1:myje,l),myie*myje)
      ENDDO
C----------------------------------------------------------------------
      call coal(ACPREC(1:myie,1:myje),myie*myje)
      call coal(CUPREC(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
      call coal(SPL,lsm)  ! ioannis give value
      call coal(DFL,lp1)
C----------------------------------------------------------------------
CPK      call coal(TSHLTR(1:myie,1:myje),myie*myje)
CPK      call coal(U10(1:myie,1:myje),myie*myje)
CPK      call coal(V10(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
C     IFOG
      DO L = 1, LM
         call coal(OMGALF(1:myie,1:myje,l),myie*myje)
      ENDDO
C----------------------------------------------------------------------
      call coal(ACSNOW(1:myie,1:myje),myie*myje)
      DO L = 1, LM
         call coal(Q2(1:myie,1:myje,l),myie*myje) ! ioannis new
      ENDDO

C----------------------------------------------------------------------
CPK      call coal(SM(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
CPK      call coal(SNO(1:myie,1:myje),myie*myje)
C**********************************************************************
      LABEL='I N I T   FILE meteo fields'
cioannis	print_init=.TRUE.   ! ioannis
      call coal(IDAT,3)
      call coal(IHRST,1)
      call coal(IHR,1)
      call coal(PRINT_INIT,1)
      call coal(LABEL,8)
C----------------------------------------------------------------------
      call coal(RES(1:myie,1:myje),myie*myje)
      call coal(FIS(1:myie,1:myje),myie*myje)
      call coal(PT,1)
      call coal(DT,1)
      call coal(ETA,lp1)
C----------------------------------------------------------------------
      DO L = 1, LM
         call coal(HTM(1:myie,1:myje,l),myie*myje)
         call coal(VTM(1:myie,1:myje,l),myie*myje)
      ENDDO
C----------------------------------------------------------------------
      call coal(LMH(1:myie,1:myje),myie*myje)
      call coal(LMV(1:myie,1:myje),myie*myje)
      call coal(SM(1:myie,1:myje),myie*myje)
      call coal(SICE(1:myie,1:myje),myie*myje)
      call coal(SST(1:myie,1:myje),myie*myje)
      call coal(IVGTYP(1:myie,1:myje),myie*myje)
      call coal(ISLTYP(1:myie,1:myje),myie*myje)
      call coal(TG(1:myie,1:myje),myie*myje)
C**********************************************************************
      LABEL='F I E L D S   FILE meteo fields'
cioannis	print_fields=.TRUE.  ! ioannis
      call coal(IDAT,3)
      call coal(IHRST,1)
      call coal(IHR,1)
      call coal(PRINT_FIELDS,1)
      call coal(NPFIELDS,1)  ! ioannis give value
      call coal(LABEL,8)
C----------------------------------------------------------------------
      call coal(PT2,1)
      call coal(THS(1:myie,1:myje),myie*myje)
      call coal(TSHLTR(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(QSHLTR(1:myie,1:myje),myie*myje)
      call coal(Q10(1:myie,1:myje),myie*myje)
CPK      call coal(ACPREC(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
      call coal(RSWIN(1:myie,1:myje),myie*myje)
      call coal(RSWOUT(1:myie,1:myje),myie*myje)
      call coal(RSWTOA(1:myie,1:myje),myie*myje)
      call coal(RLWIN(1:myie,1:myje),myie*myje)
      call coal(RLWOUT(1:myie,1:myje),myie*myje)
      call coal(RLWTOA(1:myie,1:myje),myie*myje)
C----------------------------------------------------------------------
      call coal(TWBS(1:myie,1:myje),myie*myje)
      call coal(QWBS(1:myie,1:myje),myie*myje)
cioannis      call coal(ALB(1:myie,1:myje),myie*myje)
      call coal(ALBEDO(1:myie,1:myje),myie*myje)
      call coal(Z0(1:myie,1:myje),myie*myje)
      call coal(USTAR(1:myie,1:myje),myie*myje)
      call coal(PSLP(1:myie,1:myje),myie*myje)
C  SEAG
CPK      call coal(SMC(1:myie,1:myje,1:nsoil),myie*myje*nsoil)
CPK      call coal(STC(1:myie,1:myje,1:nsoil),myie*myje*nsoil)
c ------ cloud fields added on 20/11/03 -------------------------------
      call coal(CFRACL(1:myie,1:myje),myie*myje)
      call coal(CFRACM(1:myie,1:myje),myie*myje)
      call coal(CFRACH(1:myie,1:myje),myie*myje)
c ---------------------------------------------------------------------
      LABEL='W A V E fields'
      call coal(LABEL,8)
      call coal(TPH0D,1)
      call coal(TLM0D,1)
      call coal(DLMD,1)
      call coal(DPHD,1)
      call coal(WBD,1)
      call coal(SBD,1)
      call coal(idtpro,12)
      call coal(COUPLE_WAVE,1)
      call coal(DT_WAVE_RATIO,1)
      call coal(USE_U10,1)
      call coal(wavepar(1:myie,1:myje),myie*myje)
      call coal(z0gpar(1:myie,1:myje),myie*myje)
      call coal(swhgpar(1:myie,1:myje),myie*myje)
      call coal(wdirpar(1:myie,1:myje),myie*myje)
      call coal(wmaskpar(1:myie,1:myje),myie*myje)
      call coal(agegpar(1:myie,1:myje),myie*myje)
      call coal(Uneu(1:myie,1:myje),myie*myje)
      call coal(Vneu(1:myie,1:myje),myie*myje)
C  LPBL-DHPBL coupling
      call coal(HPBL2(1:myie,1:myje),myie*myje)
      call coal(LPBL2(1:myie,1:myje),myie*myje)
c ---------------------------------------------------------------------
C**********************************************************************
      LABEL='G R O U N D   FILE meteo fields'
cioannis	print_ground=.TRUE. ! ioannis
      call coal(IDAT,3)
      call coal(IHRST,1)
      call coal(IHR,1)
      call coal(PRINT_GROUND,1)
      call coal(NPGROUND,1)  ! ioannis give value
      call coal(LABEL,8)
C----------------------------------------------------------------------
      call coal(SMC(1:myie,1:myje,1:nsoil),myie*myje*nsoil)
      call coal(STC(1:myie,1:myje,1:nsoil),myie*myje*nsoil)
      call coal(SH2O(1:myie,1:myje,1:nsoil),myie*myje*nsoil) ! ioannis
      call coal(SNO(1:myie,1:myje),myie*myje)
      call coal(VEGFRC(1:myie,1:myje),myie*myje)
      call coal(SI(1:myie,1:myje),myie*myje) ! ioannis

C ---- IOANNIS ...FINISHED WRITING OUTPUT SIMILARLY TO AURORA-----

C----------------------------------------------------------------------
C     AT THIS POINT WE HAVE ACCUMULATED ALL OF THE DATA INTO BUF.
C     WE WANT TO KNOW THE MAXIMUM AMOUNT ACROSS ALL MPI TASKS
C     THIS IS USEFUL IN CASE WE DECIDE TO WRITE A FILE
C     INSTEAD OF SENDING THE DATA TO THE I/O SERVERS
C
      CALL MPI_ALLREDUCE(IP,IPMAX,1,MPI_INTEGER,MPI_MAX,
     *   MPI_COMM_COMP,IERR)
C    
C     IPMAX IS THE MAXIMUM NUMBER OF 4 BYTE REALS ACROSS
C     THE MPI TASKS
C     LETS COMPUTE A RECLEN THAT IS A MULTIPLE OF 2**18 BYTES
C     WE WILL USE THIS WHEN OPENING THE DIRECT ACCESS FILE
C
      IBLOCK = ((IPMAX*4)/(2**18) ) + 1
      IRECLEN = IBLOCK * ( 2**18 )
C
C     WE WILL PLACE THE RECLEN IN THE BEGINNING OF THE FILE
C     THIS IS HANDY
C
      CALL REPLACE(IRECLEN,1,1) 
C
C     IF WE HAVE ANY I/O SERVERS WE WILL SEND THE DATA TO THEM
C     FOR PROCESSING
C
      IF ( IQUILT_GROUP .GT. 0 ) THEN
C
      IF ( MYPE .EQ. 0 ) THEN
         CALL MPI_SEND
     *   (ITAG,1,MPI_INTEGER,0,0,MPI_COMM_INTER_ARRAY(ISERVE),IERR)
      ENDIF
C
      DO I = 0, INUMQ(ISERVE) -1
cioannis         CALL PARA_RANGE(0, jnpes-1, INUMQ(ISERVE), I, ISTART, IEND)
      call para_range(0, NPES-1,inumq(iserve), i, istart, iend)
cioannis         MYPE_ROW = MYPE / INPES
C
cioannis         IF(MYPE_ROW .GE. ISTART .AND. MYPE_ROW .LE. IEND )THEN
         IF(MYPE .GE. ISTART .AND. MYPE .LE. 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
C
      ENDDO
C
C     IN CASE WE HAVE MULTIPLE GROUPS OF I/O SERVERS, INCREMENT TO THE
C     NEXT SERVER FOR THE NEXT OUTPUT TIME
C
      ISERVE = ISERVE + 1
      IF ( ISERVE .GT. IQUILT_GROUP ) ISERVE = 1
C
C     APPARENTLY, WE HAVE CHOSEN NOT TO SUPPLY ANY I/O SERVERS
C     WE WILL WRITE A DIRECT ACCESS FILE INSTEAD
C
      ELSE
C
        OPEN(UNIT=LRSTRT,FILE=RSTFIL,FORM='UNFORMATTED',IOSTAT=IER,
     *    ACCESS='DIRECT',RECL=IRECLEN)
        IF(IER.NE.0)WRITE(LIST,*)' LRSTRT OPEN UNIT ERROR IER=',IER
C
        WRITE(LRSTRT,REC=MYPE+1) (BUF(I),I=1,IP)
        CLOSE(LRSTRT)
C
      ENDIF
c
cioannis      dif_tim=timef()-btim0
cioannis      wrt_tim=wrt_tim+dif_tim
cioannis      call mpi_reduce(wrt_tim,wrt_tim_0,1,MPI_REAL,MPI_MAX,0,
cioannis     1                MPI_COMM_COMP,ierr)
cioannis      if(mype.eq.0)then
cioannis        write(6,*)' SHIPPED OR WROTE DATA, TIME = ',
cioannis     *    wrt_tim_0*1.e-03
cioannis      endif
      CALL MPI_BARRIER(MPI_COMM_COMP,ISTAT)
C***
C***  SEND SIGNAL THAT ALL TASKS HAVE FINISHED WRITING
C***
cioannis      IF(IQUILT_GROUP.EQ.0)THEN
cioannis      IF(MYPE.EQ.0)THEN
cioannis        DONE='DONE'
cioannis        WRITE(FINFIL,1190)ITAG,RESTHR
cioannis 1190   FORMAT('fcstdone',I3.3,'.',A4)
cioannis        LFINFIL=91
cioannis        CLOSE(LFINFIL)
cioannis        OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER)
cioannis        WRITE(LFINFIL)DONE
cioannis        CLOSE(LFINFIL)
cioannis        IF(IER.NE.0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL:  DONE'
cioannis      ENDIF
cioannis      ENDIF
C----------------------------------------------------------------------
C
C***  RESET ACCUMULATION COUNTERS TO ZERO.
C
      APHTIM=0.
      ACUTIM=0.
      ARATIM=0.

C----------------------------------------------------------------------
C***
C***  POST-POSTING UPDATING AND INITIALIZING.
C***
C--------------------------------------------------------------------
C***  IF (NTSD.EQ.NSHDE), THEN THIS WAS ALSO A FORECAST
C***  OUTPUT TIME.  WE NEED TO INCREMENT NSHDE FOR THE
C***  NEXT FORECAST OUTPUT TIME.
C
cioannis      IF(NTSD.EQ.NSHDE.OR.NSTART+1.EQ.NSHDE)THEN
      IF(NTSD.EQ.NSHDE)THEN  ! ioannis
        IOUT = IOUT+1
        IF (.NOT.RESTRT)   GO TO 1300
cioannis        IF (NTSD.EQ.NSHDE.OR.NSTART+1.EQ.NSHDE) GO TO 1300
        IF (NTSD.EQ.NSHDE) GO TO 1300  ! ioannis
        IOUT  = IOUT-1
 1300   NSHDE = ISHDE(IOUT)
      ENDIF
C
C***  ZERO ACCUMULATOR ARRAYS.
C***  AVERAGE CLOUD AMOUNT ARRAY
C
 1310 CONTINUE
cioannis      IF(MOD(NTSD,NCLOD).LT.NPHS)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)'CHKOUT: ZERO AVG CLD AMT ARRAY'
cioannis        DO J=MYJS,MYJE
cioannis        DO I=MYIS,MYIE
cioannis          ACFRCV(I,J) = 0.
cioannis          NCFRCV(I,J) = 0
cioannis          ACFRST(I,J) = 0.
cioannis          NCFRST(I,J) = 0
cioannis        ENDDO
cioannis        ENDDO
cioannis      ENDIF
C
C***  TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
C***  TOTAL SNOW AND SNOW MELT ARRAYS.
C***  STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
C***  PRECIPITATION TYPE ARRAY
C
cioannis      IF(MOD(NTSD,NPREC).LT.NCNVC)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)
cioannis     1                 'CHKOUT: ZERO ACCUM PRECIP ARRAYS'
cioannis        DO J=MYJS,MYJE
cioannis        DO I=MYIS,MYIE
cioannis          ACPREC(I,J) = 0.
cioannis          CUPREC(I,J) = 0.
cioannis          ACSNOW(I,J) = 0.
cioannis          ACSNOM(I,J) = 0.
cioannis          SSROFF(I,J) = 0.
cioannis          BGROFF(I,J) = 0.
cioannis          SFCEVP(I,J) = 0.
cioannis          POTEVP(I,J) = 0.
cioannis        ENDDO
cioannis        ENDDO
cioannis      ENDIF
C
C***  GRID-SCALE AND CONVECTIVE (LATENT) HEATING ARRAYS.
C
cioannis      IF(MOD(NTSD,NHEAT).LT.NCNVC)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)
cioannis     1                 'CHKOUT: ZERO ACCUM LATENT HEATING ARRAYS'
cioannis        AVRAIN = 0.
cioannis        AVCNVC = 0.
cioannis        DO L=1,LM
cioannis          DO J=MYJS,MYJE
cioannis          DO I=MYIS,MYIE
cioannis            TRAIN(I,J,L) = 0.
cioannis            TCUCN(I,J,L) = 0.
cioannis          ENDDO
cioannis          ENDDO
cioannis        ENDDO
cioannis      ENDIF
C     
C***  CONVECTIVE CLOUD TOP AND BOTTOM ARRAYS
C
cioannis      DO J=MYJS,MYJE
cioannis      DO I=MYIS,MYIE
cioannis        CNVBOT(I,J)=0.
cioannis        CNVTOP(I,J)=0.
cioannis      ENDDO
cioannis      ENDDO
C
C***  LONG WAVE RADIATION ARRAYS.
C     
cioannis      IF(MOD(NTSD,NRDLW).LT.NPHS)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)
cioannis     1                 'CHKOUT: ZERO ACCUM LW RADTN ARRAYS'
cioannis        ARDLW = 0.
cioannis        DO J=MYJS,MYJE
cioannis        DO I=MYIS,MYIE
cioannis          ALWIN(I,J) = 0.
cioannis          ALWOUT(I,J) = 0.
cioannis          ALWTOA(I,J) = 0.
cioannis        ENDDO
cioannis        ENDDO
cioannis      ENDIF
C     
C***  SHORT WAVE RADIATION ARRAYS.
C     
cioannis      IF(MOD(NTSD,NRDSW).LT.NPHS)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)
cioannis     1                 'CHKOUT:  ZERO ACCUM SW RADTN ARRAYS'
cioannis        ARDSW = 0.
cioannis        DO J=MYJS,MYJE
cioannis        DO I=MYIS,MYIE
cioannis          ASWIN(I,J) = 0.
cioannis          ASWOUT(I,J) = 0.
cioannis          ASWTOA(I,J) = 0.
cioannis        ENDDO
cioannis        ENDDO
cioannis      ENDIF
C     
C***  SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS.
C     
cioannis      IF(MOD(NTSD,NSRFC).LT.NPHS)THEN
cioannis        IF(MYPE.EQ.0)WRITE(LIST,*)
cioannis     1                 'CHKOUT:  ZERO ACCUM SFC FLUX ARRAYS'
cioannis        ASRFC = 0.
cioannis        DO J=MYJS,MYJE
cioannis        DO I=MYIS,MYIE
cioannis          SFCSHX(I,J) = 0.
cioannis          SFCLHX(I,J) = 0.
cioannis          SUBSHX(I,J) = 0.
cioannis          SNOPCX(I,J) = 0.
cioannis          SFCUVX(I,J) = 0.
cioannis          POTFLX(I,J) = 0.
cioannis        ENDDO
cioannis        ENDDO
cioannis      ENDIF
C
C***  RESET THE MAX/MIN TEMPERATURE ARRAYS
C
cioannis      DO J=MYJS,MYJE
cioannis      DO I=MYIS,MYIE
cioannis        TLMIN(I,J)=999.
cioannis        TLMAX(I,J)=-999.
cioannis      ENDDO
cioannis      ENDDO
C
C     END OF ROUTINE.
C

Ctas      write(0,*) 'leaving CHKOUT!!!!'
      RETURN
      END
      SUBROUTINE COAL(A,LEN)
      INCLUDE "BUFFER.comm"
      INCLUDE 'mpif.h'
      REAL A(*)
      IF ( LEN .LT. 0 ) THEN
         IP = 0
      END IF
      IF ( IP + LEN .GT. IBUFMAX ) THEN
         PRINT *, ' IBUFMAX in BUFFER.comm is too small, stopping'
         PRINT *, ' CHANGE IBUFMAX in parmbuf 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 REPLACE(A,LEN,IW)
      INCLUDE "BUFFER.comm"
      REAL A(*)
      IPP = IW
      DO I = 1, LEN
         BUF(IPP) = A(I)
         IPP = IPP + 1
      END DO
      END
