    SUBROUTINE QUILT

!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
!   SUBROUTINE:  QUILT     I/O SERVERS
!   PRGRMMR: TUCCILLO        ORG:  IBM       DATE: 00-01-20

! ABSTRACT:  I/O SERVERS

! PROGRAM HISTORY LOG:
!   00-01-20  TUCCILLO - ORIGINATOR
!   00-11-02  BLACK - SLP FOR NEST BOUNDARIES
!   00-12-12  BLACK - RESTART CAPABILITY

! USAGE:  CALL QUILT

!   INPUT ARGUMENT LIST:
!     NONE

!   OUTPUT ARGUMENT LIST:
!     NONE

!   INPUT FILES:  NONE

!   OUTPUT FILES:  NONE

!   SUBPROGRAMS CALLED:
!     UNIQUE:
!            MPI_RECV
!            MPI_BCAST
!            COLLECT
!            SLP
!            DECOAL

!   EXIT STATES:
!     COND =   0 - NORMAL EXIT

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

!$$$

!     THIS CODE ASSUMES THAT NSOIL IS GE TO 4. IF THIS IS NOT TRUE,
!     THE CODE WILL STOP. THE EQUIVALENCING IS THE PROBLEM.

!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "parmsoil.f90"
    INCLUDE "mpif.h"
    INCLUDE "mpp.h"
!-----------------------------------------------------------------------
    INCLUDE "COMM_PARA.f90"
    INCLUDE "COMM_BUFFER.f90"
!-----------------------------------------------------------------------
    PARAMETER &
    (LB=2*IM+JM-3)
!-----------------------------------------------------------------------

    REAL :: DUM1(IM,JM),DUM2(IM,JM),DUM3(IM,JM),DUM4(IM,JM)
    REAL :: DUM5(IM,JM),DUM6(IM,JM),DUM7(IM,JM)
! SM v100m
    REAL :: DUM8(IM,JM),DUM9(IM,JM),DUM10(IM,JM),DUM11(IM,JM)
! SM v100m
    REAL :: DUMS(IM,JM,NSOIL)
    INTEGER :: STATUS(MPI_STATUS_SIZE)
    EQUIVALENCE ( DUM1(1,1), DUMS(1,1,1) )
    EQUIVALENCE ( DUM2(1,1), DUMS(1,1,2) )
    EQUIVALENCE ( DUM3(1,1), DUMS(1,1,3) )
    EQUIVALENCE ( DUM4(1,1), DUMS(1,1,4) )

!-----------------------------------------------------------------------
    REAL, ALLOCATABLE :: &
    PDOMG(:,:),RESOMG(:,:),PD(:,:),RES(:,:),FIS(:,:) &
    ,RSWIN(:,:),RSWOUT(:,:),TG(:,:),Z0(:,:),AKMS(:,:) &
    ,CZEN(:,:),AKHS(:,:),THS(:,:),QS(:,:),TWBS(:,:) &
    ,QWBS(:,:),HBOT(:,:),CFRACL(:,:),THZ0(:,:),QZ0(:,:) &
    ,UZ0(:,:),VZ0(:,:),USTAR(:,:),HTOP(:,:),CFRACM(:,:) &
    ,SNO(:,:),SI(:,:),CLDEFI(:,:),RF(:,:),PSLP(:,:) &
    ,CUPPT(:,:),CFRACH(:,:),SOILTB(:,:),SFCEXC(:,:) &
    ,SMSTAV(:,:),SMSTOT(:,:),GRNFLX(:,:),PCTSNO(:,:) &
    ,RLWIN(:,:),RADOT(:,:),CZMEAN(:,:),SIGT4(:,:) &
    ,U00(:,:),SR(:,:),PREC(:,:),ACPREC(:,:),ACCLIQ(:,:) &
    ,CUPREC(:,:),ACFRCV(:,:),ACFRST(:,:),SFCSHX(:,:) &
    ,ACSNOW(:,:),ACSNOM(:,:),SSROFF(:,:),BGROFF(:,:) &
    ,SFCLHX(:,:),SUBSHX(:,:),SNOPCX(:,:),SFCUVX(:,:) &
    ,SFCEVP(:,:),POTEVP(:,:),ASWIN(:,:),ASWOUT(:,:) &
    ,ASWTOA(:,:),ALWIN(:,:),ALWOUT(:,:),ALWTOA(:,:) &
! SM v100m
    ,TH100(:,:),Q100(:,:),U100(:,:),V100(:,:) &
! SM v100m
    ,TH10(:,:),Q10(:,:),U10(:,:),V10(:,:),TSHLTR(:,:) &
    ,QSHLTR(:,:),PSHLTR(:,:),CMC(:,:),POTFLX(:,:) &
    ,TLMIN(:,:),TLMAX(:,:),RSWTOA(:,:),RLWTOA(:,:) &
    ,CNVBOT(:,:),CNVTOP(:,:),ALBEDO(:,:) &
! p
    ,SM(:,:),HBM2(:,:),DETA(:)
! p

    REAL :: UL(2*LM)

    REAL, ALLOCATABLE :: &
    OMGALF(:,:,:),T(:,:,:),Q(:,:,:),U(:,:,:) &
    ,V(:,:,:),Q2(:,:,:),TTND(:,:,:),CWM(:,:,:) &
    ,TRAIN(:,:,:),TCUCN(:,:,:) &
    ,RSWTT(:,:,:),RLWTT(:,:,:)

    REAL, ALLOCATABLE :: &
    SMC(:,:,:),STC(:,:,:),SH2O(:,:,:)
    REAL :: &
    PDB(LB,2),TB(LB,LM,2),QB(LB,LM,2),UB(LB,LM,2),VB(LB,LM,2) &
    ,Q2B(LB,LM,2),CWMB(LB,LM,2)

!-----------------------------------------------------------------------
    INTEGER :: IDAT(3)

    INTEGER, ALLOCATABLE :: &
    LC(:,:),NCFRCV(:,:),NCFRST(:,:)
!-----------------------------------------------------------------------
    LOGICAL :: &
    RUN,FIRST,HYDRO,SIGMA
! p     & RUN,FIRST
!-----------------------------------------------------------------------
    CHARACTER &
    RSTFIL1*50,RSTFIL2*50,RESTHR*4,LABEL*32 &
    ,FNAME*80,ENVAR*50,BLANK*4
    CHARACTER FINFIL*50,DONE*10

    CHARACTER (LEN=200) :: submit	      ! chou
    CHARACTER (LEN=200) :: chmo
    CHARACTER(85) :: LINE
    CHARACTER(25) ::  OUTJOB
           
    LOGICAL :: LME, OUTJ
!-----------------------------------------------------------------------
    DATA LRSTRT1/21/,LRSTRT2/61/,NHB/12/,BLANK/'    '/
!-----------------------------------------------------------------------

    real*8 :: timef, ist, isp, rtc, ist2, isp2, icum
!-----------------------------------------------------------------------
    REAL,DIMENSION(999999) :: TSHDE
    REAL,DIMENSION(LSM) :: SPL
    LOGICAL :: RESTRT,SINGLRST,SUBPOST,NEST,SPLINE

!     DECLARE NAMELIST

    NAMELIST /FCSTDATA/ &
    TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL &
    ,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP &
    ,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC &
    ,NEST,HYDRO,SPLINE


    NAMELIST /POSTLIST/chmo
    NAMELIST /POSTLIST/submit    !chou

!-----------------------------------------------------------------------
    CALL MPI_FIRST
!***
!***  READ NAMELIST FCSTDATA TO FIND OUT IF THIS IS A NESTED RUN
!***

    LFCSTD = 11
    open(LFCSTD,file='fcstdata.meso',status='old')
    READ(LFCSTD,FCSTDATA)

    IF(NSOIL < 4)THEN
        PRINT*, ' NSOIL IS LESS THAN 4. CHANGE THE EQUIVALENCES'
        PRINT*, ' STOPPING'
        CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
    ENDIF

    IF(ME == 0)THEN
        LME= .TRUE. 
    ELSE
        LME= .FALSE. 
    ENDIF
! p
! READ NHB FILE TO OBTAIN SIGMA
          
    open(unit=NHB,form='unformatted',file='cnst.file')
    REWIND NHB
    READ(NHB)NFCST,NBC,LIST,DT,IDTAD,SIGMA
    print*,'in quilt, sigma= ',sigma
    print*,'in quilt, sigma= ',sigma
    print*,'in quilt, sigma= ',sigma

! p


    ALLOCATE(PDOMG(IM,MY_JSD:MY_JED))
    ALLOCATE(RESOMG(IM,MY_JSD:MY_JED))
    ALLOCATE(OMGALF(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(PD(IM,MY_JSD:MY_JED))
    ALLOCATE(RES(IM,MY_JSD:MY_JED))
    ALLOCATE(FIS(IM,MY_JSD:MY_JED))
    ALLOCATE(T(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(Q(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(U(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(V(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(Q2(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(TTND(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(CWM(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(TRAIN(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(TCUCN(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(RSWIN(IM,MY_JSD:MY_JED))
    ALLOCATE(RSWOUT(IM,MY_JSD:MY_JED))
    ALLOCATE(TG(IM,MY_JSD:MY_JED))
    ALLOCATE(Z0(IM,MY_JSD:MY_JED))
    ALLOCATE(AKMS(IM,MY_JSD:MY_JED))
    ALLOCATE(CZEN(IM,MY_JSD:MY_JED))
    ALLOCATE(AKHS(IM,MY_JSD:MY_JED))
    ALLOCATE(THS(IM,MY_JSD:MY_JED))
    ALLOCATE(QS(IM,MY_JSD:MY_JED))
    ALLOCATE(TWBS(IM,MY_JSD:MY_JED))
    ALLOCATE(QWBS(IM,MY_JSD:MY_JED))
    ALLOCATE(HBOT(IM,MY_JSD:MY_JED))
    ALLOCATE(CFRACL(IM,MY_JSD:MY_JED))
    ALLOCATE(THZ0(IM,MY_JSD:MY_JED))
    ALLOCATE(QZ0(IM,MY_JSD:MY_JED))
    ALLOCATE(UZ0(IM,MY_JSD:MY_JED))
    ALLOCATE(VZ0(IM,MY_JSD:MY_JED))
    ALLOCATE(USTAR(IM,MY_JSD:MY_JED))
    ALLOCATE(HTOP(IM,MY_JSD:MY_JED))
    ALLOCATE(SNO(IM,MY_JSD:MY_JED))
    ALLOCATE(SI(IM,MY_JSD:MY_JED))
    ALLOCATE(CLDEFI(IM,MY_JSD:MY_JED))
    ALLOCATE(RF(IM,MY_JSD:MY_JED))
    ALLOCATE(PSLP(IM,MY_JSD:MY_JED))
    ALLOCATE(CUPPT(IM,MY_JSD:MY_JED))
    ALLOCATE(CFRACH(IM,MY_JSD:MY_JED))
    ALLOCATE(CFRACM(IM,MY_JSD:MY_JED))
    ALLOCATE(SOILTB(IM,MY_JSD:MY_JED))
    ALLOCATE(SFCEXC(IM,MY_JSD:MY_JED))
    ALLOCATE(SMSTAV(IM,MY_JSD:MY_JED))
    ALLOCATE(SMSTOT(IM,MY_JSD:MY_JED))
    ALLOCATE(GRNFLX(IM,MY_JSD:MY_JED))
    ALLOCATE(PCTSNO(IM,MY_JSD:MY_JED))
    ALLOCATE(RLWIN(IM,MY_JSD:MY_JED))
    ALLOCATE(RADOT(IM,MY_JSD:MY_JED))
    ALLOCATE(CZMEAN(IM,MY_JSD:MY_JED))
    ALLOCATE(SIGT4(IM,MY_JSD:MY_JED))
    ALLOCATE(U00(IM,MY_JSD:MY_JED))
    ALLOCATE(LC(IM,MY_JSD:MY_JED))
    ALLOCATE(SR(IM,MY_JSD:MY_JED))
    ALLOCATE(PREC(IM,MY_JSD:MY_JED))
    ALLOCATE(ACPREC(IM,MY_JSD:MY_JED))
    ALLOCATE(ACCLIQ(IM,MY_JSD:MY_JED))
    ALLOCATE(CUPREC(IM,MY_JSD:MY_JED))
    ALLOCATE(ACFRCV(IM,MY_JSD:MY_JED))
    ALLOCATE(NCFRCV(IM,MY_JSD:MY_JED))
    ALLOCATE(ACFRST(IM,MY_JSD:MY_JED))
    ALLOCATE(NCFRST(IM,MY_JSD:MY_JED))
    ALLOCATE(ACSNOW(IM,MY_JSD:MY_JED))
    ALLOCATE(ACSNOM(IM,MY_JSD:MY_JED))
    ALLOCATE(SSROFF(IM,MY_JSD:MY_JED))
    ALLOCATE(BGROFF(IM,MY_JSD:MY_JED))
    ALLOCATE(SFCSHX(IM,MY_JSD:MY_JED))
    ALLOCATE(SFCLHX(IM,MY_JSD:MY_JED))
    ALLOCATE(SUBSHX(IM,MY_JSD:MY_JED))
    ALLOCATE(SNOPCX(IM,MY_JSD:MY_JED))
    ALLOCATE(SFCUVX(IM,MY_JSD:MY_JED))
    ALLOCATE(SFCEVP(IM,MY_JSD:MY_JED))
    ALLOCATE(POTEVP(IM,MY_JSD:MY_JED))
    ALLOCATE(ASWIN(IM,MY_JSD:MY_JED))
    ALLOCATE(ASWOUT(IM,MY_JSD:MY_JED))
    ALLOCATE(ASWTOA(IM,MY_JSD:MY_JED))
    ALLOCATE(ALWIN(IM,MY_JSD:MY_JED))
    ALLOCATE(ALWOUT(IM,MY_JSD:MY_JED))
    ALLOCATE(ALWTOA(IM,MY_JSD:MY_JED))
! SM v100m
    ALLOCATE(TH100(IM,MY_JSD:MY_JED))
    ALLOCATE(Q100(IM,MY_JSD:MY_JED))
    ALLOCATE(U100(IM,MY_JSD:MY_JED))
    ALLOCATE(V100(IM,MY_JSD:MY_JED))
! SM v100m
    ALLOCATE(TH10(IM,MY_JSD:MY_JED))
    ALLOCATE(Q10(IM,MY_JSD:MY_JED))
    ALLOCATE(U10(IM,MY_JSD:MY_JED))
    ALLOCATE(V10(IM,MY_JSD:MY_JED))
    ALLOCATE(TSHLTR(IM,MY_JSD:MY_JED))
    ALLOCATE(QSHLTR(IM,MY_JSD:MY_JED))
    ALLOCATE(PSHLTR(IM,MY_JSD:MY_JED))
    ALLOCATE(SMC(IM,MY_JSD:MY_JED,1:NSOIL))
    ALLOCATE(CMC(IM,MY_JSD:MY_JED))
    ALLOCATE(STC(IM,MY_JSD:MY_JED,1:NSOIL))
    ALLOCATE(SH2O(IM,MY_JSD:MY_JED,1:NSOIL))
    ALLOCATE(ALBEDO(IM,MY_JSD:MY_JED))
    ALLOCATE(POTFLX(IM,MY_JSD:MY_JED))
    ALLOCATE(TLMIN(IM,MY_JSD:MY_JED))
    ALLOCATE(TLMAX(IM,MY_JSD:MY_JED))
    ALLOCATE(RSWTT(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(RLWTT(IM,MY_JSD:MY_JED,1:LM))
    ALLOCATE(CNVBOT(MY_ISD:MY_IED,MY_JSD:MY_JED))
    ALLOCATE(CNVTOP(MY_ISD:MY_IED,MY_JSD:MY_JED))
    ALLOCATE(RSWTOA(MY_ISD:MY_IED,MY_JSD:MY_JED))
    ALLOCATE(RLWTOA(MY_ISD:MY_IED,MY_JSD:MY_JED))
! p
    ALLOCATE(HBM2(IM,MY_JSD:MY_JED))
    ALLOCATE(SM(IM,MY_JSD:MY_JED))
    ALLOCATE(DETA(1:LM))
! p

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!***
!***  LOOP OVER ALL THE OUTPUT TIMES
!***
!-----------------------------------------------------------------------
    666 CONTINUE

    IF(ME == 0)THEN
        CALL MPI_RECV(IHOUR,1,MPI_INTEGER,0,0,MPI_COMM_INTER,STATUS,IER)
        PRINT*,' ihour in quilt = ',IHOUR
    ENDIF

    CALL MPI_BCAST(IHOUR,1,MPI_INTEGER,0,MPI_COMM_COMP,IER)

    IF(IHOUR == -999)GO TO 667
!      IST=RTC()
!      ICUM=0.
!-----------------------------------------------------------------------
    DO 200 IXXX=1,JEND(ME)-JSTA(ME)+1
    !-----------------------------------------------------------------------
    !***
    !***  RECEIVE ALL THE DATA FROM CHKOUT FROM
    !***  THE APPROPRIATE FORECAST TASKS
    !***
        ist=timef()
        CALL MPI_RECV(BUF,IBUFMAX,MPI_REAL,MPI_ANY_SOURCE,IHOUR, &
        MPI_COMM_INTER,STATUS,IER)
        IPE=STATUS(MPI_SOURCE)
    
        IF(IER /= 0)THEN
            PRINT*,' error from mpi_rec = ',IER
        ENDIF
    
    !      ist2 = rtc()
    
        IS=MY_IS_GLB_A(IPE)
        IE=MY_IE_GLB_A(IPE)
        JS=MY_JS_GLB_A(IPE)
        JE=MY_JE_GLB_A(IPE)
        LEN_CH=(IE-IS+1)*(JE-JS+1)
    
    !     EXTRACT RECORD LENGTH - LETS KEEP THIS BECAUSE IT IS POTENTIALLY HANDY
        CALL DECOAL(IDUM,-1)
    
        CALL DECOAL(RUN,1)
        CALL DECOAL(IDAT,3)
        CALL DECOAL(IHRST,1)
        CALL DECOAL(NTSD,1)
        CALL DECOAL(LABEL,8)
        CALL DECOAL(PDOMG(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RESOMG(IS:IE,JS:JE),LEN_CH)
    
        DO L=1,LM
            CALL DECOAL(OMGALF(IS:IE,JS:JE,L),LEN_CH)
        ENDDO
    
        CALL DECOAL(RUN,1)
        CALL DECOAL(IDAT,3)
        CALL DECOAL(IHRST,1)
        CALL DECOAL(NTSD,1)
        CALL DECOAL(LABEL,8)
        CALL DECOAL(FIRST,1)
        CALL DECOAL(IOUT,1)
        CALL DECOAL(NSHDE,1)
        CALL DECOAL(PD(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RES(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(FIS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(PDB,LB*2)
        CALL DECOAL(TB,LB*LM*2)
        CALL DECOAL(QB,LB*LM*2)
        CALL DECOAL(UB,LB*LM*2)
        CALL DECOAL(VB,LB*LM*2)
        CALL DECOAL(Q2B,LB*LM*2)
        CALL DECOAL(CWMB,LB*LM*2)
    
        DO L=1,LM
            CALL DECOAL(T(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(Q(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(U(IS:IE,JS:JE,l),LEN_CH)
            CALL DECOAL(V(IS:IE,JS:JE,l),LEN_CH)
            CALL DECOAL(Q2(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(TTND(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(CWM(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(TRAIN(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(TCUCN(IS:IE,JS:JE,L),LEN_CH)
        ENDDO
    
        CALL DECOAL(RUN,1)
        CALL DECOAL(IDAT,3)
        CALL DECOAL(IHRST,1)
        CALL DECOAL(NTSD,1)
        CALL DECOAL(LABEL,8)
        CALL DECOAL(RSWIN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RSWOUT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(TG(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(Z0(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(AKMS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CZEN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(AKHS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(THS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(QS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(TWBS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(QWBS(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(HBOT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CFRACL(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(THZ0(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(QZ0(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(UZ0(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(VZ0(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(USTAR(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(HTOP(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CFRACM(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SNO(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SI(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CLDEFI(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RF(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(PSLP(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CUPPT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CFRACH(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SOILTB(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SFCEXC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SMSTAV(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SMSTOT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(GRNFLX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(PCTSNO(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RLWIN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RADOT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CZMEAN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SIGT4(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(U00(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(UL,2*LM)
        CALL DECOAL(LC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SR(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RUN,1)
        CALL DECOAL(IDAT,3)
        CALL DECOAL(IHRST,1)
        CALL DECOAL(NTSD,1)
        CALL DECOAL(LABEL,8)
        CALL DECOAL(PREC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACPREC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACCLIQ(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CUPREC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACFRCV(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(NCFRCV(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACFRST(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(NCFRST(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACSNOW(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACSNOM(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SSROFF(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(bgroff(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SFCSHX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SFCLHX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SUBSHX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SNOPCX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SFCUVX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(SFCEVP(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(POTEVP(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ASWIN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ASWOUT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ASWTOA(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ALWIN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ALWOUT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ALWTOA(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ARDSW,1)
        CALL DECOAL(ARDLW,1)
        CALL DECOAL(ASRFC,1)
        CALL DECOAL(AVRAIN,1)
        CALL DECOAL(AVCNVC,1)
        CALL DECOAL(TH10(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(Q10(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(U10(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(V10(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(TSHLTR(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(QSHLTR(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(PSHLTR(IS:IE,JS:JE),LEN_CH)
    ! SM v100m
        CALL DECOAL(TH100(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(Q100(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(U100(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(V100(IS:IE,JS:JE),LEN_CH)
    ! SM v100m
        CALL DECOAL(SMC(IS:IE,JS:JE,1:NSOIL),LEN_CH*NSOIL)
        CALL DECOAL(CMC(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(STC(IS:IE,JS:JE,1:NSOIL),LEN_CH*NSOIL)
        CALL DECOAL(SH2O(IS:IE,JS:JE,1:NSOIL),LEN_CH*NSOIL)
        CALL DECOAL(ALBEDO(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(POTFLX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(TLMIN(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(TLMAX(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(ACUTIM,1)
        CALL DECOAL(ARATIM,1)
        CALL DECOAL(APHTIM,1)
        CALL DECOAL(NHEAT,1)
        CALL DECOAL(NPHS,1)
        CALL DECOAL(NCNVC,1)
        CALL DECOAL(NPREC,1)
        CALL DECOAL(NRDSW,1)
        CALL DECOAL(NRDLW,1)
        CALL DECOAL(NSRFC,1)
        CALL DECOAL(TPH0D,1)
        CALL DECOAL(TLM0D,1)
        CALL DECOAL(RESTRT,1)
    
        DO L=1,LM
            CALL DECOAL(RSWTT(IS:IE,JS:JE,L),LEN_CH)
            CALL DECOAL(RLWTT(IS:IE,JS:JE,L),LEN_CH)
        enddo
    
        CALL DECOAL(CNVBOT(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(CNVTOP(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RSWTOA(IS:IE,JS:JE),LEN_CH)
        CALL DECOAL(RLWTOA(IS:IE,JS:JE),LEN_CH)
    !      icum = icum + rtc() -ist2
    ! p added for slpsig stuff
        call decoal(hbm2(is:ie,js:je),len_ch)
        call decoal(sm(is:ie,js:je),len_ch)
        call decoal(spl(1:lsm),lsm)
        call decoal(deta(1:lm),lm)
        call decoal(pt,1)
        call decoal(spline,1)
        write(6,*) 'decoaled in QUILT that SPLINE= ', SPLINE
    ! p
    200 END DO

!      isp=rtc()
!      PRINT*,' TIME FOR RECV/ASSEMBLY = ',isp-ist
!      PRINT*,' TIME FOR DECOAL = ',icum
!-----------------------------------------------------------------------
!***
!*** BEFORE WRITING OUT THE RESTRT FILE, COMPUTE THE MSLP
!***

!      ist=rtc()
! p      CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP)
    IF(SIGMA)THEN
        if(spline)then
            print*,'calling slpsigspline'
            call slpsigspline(PD,FIS,T,Q,SPL,LSM &
            ,            DETA,PT,PSLP)
        else
            print*,'calling slpsig'
            CALL SLPSIG(PD,FIS,SM,T,Q,CWM,HBM2,U00,SPL,LSM &
            ,            UL,DETA,PT,PSLP)
        end if
    ELSE
        print*,'calling slp'
        CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP)
    END IF
!      isp=rtc()
!      PRINT*,' time for SLP = ',isp-ist

!-----------------------------------------------------------------------
!***  WRITE OUT THE GLOBAL RESTRT FILE.
!-----------------------------------------------------------------------
!***
!***  GENERATE THE NAME OF THE GLOBAL OUTPUT RESTRT FILE
!***
    ENVAR=' '
    CALL GETENV("RSTFNL",ENVAR)
    CALL GETENV("tmmark",RESTHR)
    RESTHR='t00s'
    KPATH = INDEX(ENVAR,' ') -1
    IF(KPATH <= 0) KPATH = LEN(ENVAR)

    IF(RESTHR == '    ')THEN
        WRITE(RSTFIL2,280)IHOUR
        280 FORMAT('restrt',I6.6)
    ELSE
        WRITE(RSTFIL2,285)IHOUR,RESTHR
        285 FORMAT('restrt',I6.6,'.',a4)
    ENDIF

    KRST=INDEX(RSTFIL2,' ') -1
    IF(KRST <= 0)KRST=LEN(RSTFIL2)
!***
!***  OPEN UNIT TO THE GLOBAL RESTART FILE
!***
    CLOSE(LRSTRT2)

!      ist = rtc()
    IF(ENVAR(1:4) == BLANK)THEN
        OPEN(UNIT=LRSTRT2,FILE=RSTFIL2,FORM='UNFORMATTED',IOSTAT=IER)
    ELSE
        FNAME=ENVAR(1:KPATH) // RSTFIL2(1:KRST)
        OPEN(UNIT=LRSTRT2,FILE=FNAME,FORM='UNFORMATTED',IOSTAT=IER)
    ENDIF
!-----------------------------------------------------------------------
    IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour
    CALL COLLECT(PDOMG,DUM1)
    CALL COLLECT(RESOMG,DUM2)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2

    DO L=1,LM
        CALL COLLECT(OMGALF(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
    ENDDO

    IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour, &
    FIRST,IOUT,NSHDE
    CALL COLLECT(PD,DUM1)
    CALL COLLECT(RES,DUM2)
    CALL COLLECT(FIS,DUM3)
    IF(LME)WRITE(LRSTRT2) DUM1, DUM2, DUM3
    IF(LME)WRITE(LRSTRT2)PDB,TB,QB,UB,VB,Q2B,CWMB

    DO L=1,LM
        CALL COLLECT(T(:,:,L),DUM1)
    !       IF(LME)WRITE(99) DUM1
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(Q(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(U(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(V(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(Q2(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(TTND(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(CWM(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(TRAIN(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(TCUCN(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
    ENDDO

    CALL COLLECT(RSWIN,DUM1)
    CALL COLLECT(RSWOUT,DUM2)
    CALL COLLECT(TG,DUM3)
    CALL COLLECT(Z0,DUM4)
    CALL COLLECT(AKMS,DUM5)
    CALL COLLECT(CZEN,DUM6)
    IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour &
    ,           DUM1,DUM2,DUM3,DUM4,DUM5,DUM6

    CALL COLLECT(AKHS,DUM1)
    CALL COLLECT(THS,DUM2)
    CALL COLLECT(QS,DUM3)
    CALL COLLECT(TWBS,DUM4)
    CALL COLLECT(QWBS,DUM5)
    CALL COLLECT(HBOT,DUM6)
    CALL COLLECT(CFRACL,DUM7)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7

    CALL COLLECT(THZ0,DUM1)
    CALL COLLECT(QZ0,DUM2)
    CALL COLLECT(UZ0,DUM3)
    CALL COLLECT(VZ0,DUM4)
    CALL COLLECT(USTAR,DUM5)
    CALL COLLECT(HTOP,DUM6)
    CALL COLLECT(CFRACM,DUM7)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7

    CALL COLLECT(SNO,DUM1)
    CALL COLLECT(SI,DUM2)
    CALL COLLECT(CLDEFI,DUM3)
    CALL COLLECT(RF,DUM4)
    CALL COLLECT(PSLP,DUM5)
    CALL COLLECT(CUPPT,DUM6)
    CALL COLLECT(CFRACH,DUM7)
    IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7

    CALL COLLECT(SOILTB,DUM1)
    CALL COLLECT(SFCEXC,DUM2)
    CALL COLLECT(SMSTAV,DUM3)
    CALL COLLECT(SMSTOT,DUM4)
    CALL COLLECT(GRNFLX,DUM5)
    CALL COLLECT(PCTSNO,DUM6)
    IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4,DUM5,DUM6

    CALL COLLECT(RLWIN,DUM1)
    CALL COLLECT(RADOT,DUM2)
    CALL COLLECT(CZMEAN,DUM3)
    CALL COLLECT(SIGT4,DUM4)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4

    CALL COLLECT(U00,DUM1)
    CALL COLLECT(LC,DUM2)
    CALL COLLECT(SR,DUM3)
    IF(LME)WRITE(LRSTRT2)DUM1,UL,DUM2,DUM3

    CALL COLLECT(PREC,DUM1)
    CALL COLLECT(ACPREC,DUM2)
    CALL COLLECT(ACCLIQ,DUM3)
    CALL COLLECT(CUPREC,DUM4)
    IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour &
    ,             DUM1,DUM2,DUM3,DUM4

    CALL COLLECT(ACFRCV,DUM1)
    CALL COLLECT(NCFRCV,DUM2)
    CALL COLLECT(ACFRST,DUM3)
    CALL COLLECT(NCFRST,DUM4)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4

    CALL COLLECT(ACSNOW,DUM1)
    CALL COLLECT(ACSNOM,DUM2)
    CALL COLLECT(SSROFF,DUM3)
    CALL COLLECT(BGROFF,DUM4)
    IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4

    CALL COLLECT(SFCSHX,DUM1)
    CALL COLLECT(SFCLHX,DUM2)
    CALL COLLECT(SUBSHX,DUM3)
    CALL COLLECT(SNOPCX,DUM4)
    CALL COLLECT(SFCUVX,DUM5)
    CALL COLLECT(SFCEVP,DUM6)
    CALL COLLECT(POTEVP,DUM7)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7

    CALL COLLECT(ASWIN,DUM1)
    CALL COLLECT(ASWOUT,DUM2)
    CALL COLLECT(ASWTOA,DUM3)
    CALL COLLECT(ALWIN,DUM4)
    CALL COLLECT(ALWOUT,DUM5)
    CALL COLLECT(ALWTOA,DUM6)
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6

    IF(LME)WRITE(LRSTRT2)ARDSW,ARDLW,ASRFC,AVRAIN,AVCNVC

    CALL COLLECT(TH10,DUM1)
    CALL COLLECT(Q10,DUM2)
    CALL COLLECT(U10,DUM3)
    CALL COLLECT(V10,DUM4)
    CALL COLLECT(TSHLTR,DUM5)
    CALL COLLECT(QSHLTR,DUM6)
    CALL COLLECT(PSHLTR,DUM7)
! SM V100m
    CALL COLLECT(TH100,DUM8)
    CALL COLLECT(Q100,DUM9)
    CALL COLLECT(U100,DUM10)
    CALL COLLECT(V100,DUM11)
! SM V100m
          
    IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 &
! SM  V100m
    ,                    DUM8,DUM9,DUM10,DUM11
! SM V100m

    DO L=1,NSOIL
        CALL COLLECT(SMC(:,:,L), DUMS(:,:,L))
    ENDDO
    IF(LME)WRITE(LRSTRT2) DUMS

    CALL COLLECT(CMC,DUM1)
    IF(LME)WRITE(LRSTRT2) DUM1

    DO L=1,NSOIL
        CALL COLLECT(STC(:,:,L), DUMS(:,:,L))
    ENDDO
    IF(LME)WRITE(LRSTRT2) DUMS

    DO L=1,NSOIL
        CALL COLLECT(SH2O(:,:,L), DUMS(:,:,L))
    ENDDO
    IF(LME)WRITE(LRSTRT2) DUMS

    CALL COLLECT(ALBEDO,DUM1)
    IF(LME)WRITE(LRSTRT2) DUM1

    CALL COLLECT(POTFLX,DUM1)
    CALL COLLECT(TLMIN,DUM2)
    CALL COLLECT(TLMAX,DUM3)
    IF(LME)WRITE(LRSTRT2) DUM1, DUM2, DUM3 &
    ,             ACUTIM,ARATIM,APHTIM &
    ,             NHEAT,NPHS,NCNVC,NPREC,NRDSW,NRDLW,NSRFC &
    ,             TPH0D,TLM0D,RESTRT

    DO L=1,LM
        CALL COLLECT(RSWTT(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
        CALL COLLECT(RLWTT(:,:,L),DUM1)
        IF(LME)WRITE(LRSTRT2) DUM1
    ENDDO

    CALL COLLECT(CNVBOT(:,:),DUM1)
    IF(LME) WRITE(LRSTRT2) DUM1
    CALL COLLECT(CNVTOP(:,:),DUM1)
    IF(LME) WRITE(LRSTRT2) DUM1
    CALL COLLECT(RSWTOA(:,:),DUM1)
    IF(LME) WRITE(LRSTRT2) DUM1
    CALL COLLECT(RLWTOA(:,:),DUM1)
    IF(LME) WRITE(LRSTRT2) DUM1

    CLOSE(LRSTRT2)

!      isp=rtc()

    IF(LME)THEN
    !        PRINT*,' time for I/O = ',isp-ist
    ENDIF
!-----------------------------------------------------------------------
! SM - Altera\E7\E3o feita para o IO - Para n\E3o mais escrever o outjob e fcstdone
          
    OUTJ= .TRUE. 
    IF(OUTJ)THEN
              
        IF(LME)THEN
            DONE='DONE'
            ITAG=ihour
            WRITE(FINFIL,1190)ITAG,RESTHR
            1190 FORMAT('fcstdone',I6.6,'.',A4)
            LFINFIL=91
            CLOSE(LFINFIL)
            OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER)
            WRITE(LFINFIL)DONE
            CLOSE(LFINFIL)
        ! LG
        ! SM      REWIND(11)
        ! SM        READ(11,POSTLIST)                        !  chou
        ! SM        WRITE(LIST,POSTLIST)                     !  chou

        ! SM        WRITE(outjob,1240)ITAG
        ! SM 1240   FORMAT('outjob_special',I6.6,'.ksh')
            	
        ! SM        lunin = 67
        ! SM       	lunot = 68
        ! SM	OPEN(lunin,FILE='outjob_special.ksh')
        ! SM	OPEN(lunot,FILE=outjob)
        ! SM 1260   FORMAT(a85)
            	
        ! SM	REWIND(lunin)
        ! SM	DO i=1,11
        ! SM	  READ(lunin,1260) line
        ! SM	  idx=index(line,' ')-1
        ! SM	  WRITE(lunot,1260) line
        ! SM	ENDDO
        ! SM 1261   FORMAT('Hfct=',I6.6)
        ! SM        WRITE(lunot,1261) ITAG
            	
        ! SM 1250   READ(lunin,1260,END=1290) line
        ! SM	WRITE(lunot,1260) line
        ! SM        GO TO 1250
        ! SM 1290   CONTINUE
        ! SM        close(lunot)
        ! SM	close(lunin)
                    
        ! SM        idx=index(submit,'#')-1
        ! SM        submit = submit(1:idx) // outjob
                     	
        ! SM        chx=index(chmo,'#')-1
        ! SM        chmo = chmo(1:chx) // outjob
            	
        ! SM	CALL system(chmo)
                     
        ! SM        WRITE(list,*)'CHKOUT:  SUBMIT POST JOB ',submit
        ! SM        CALL system(submit)    ! NEC equivalent
        ! LG

            IF(IER /= 0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL:  DONE'
        ENDIF
    ENDIF

    GO TO 666
    667 CONTINUE

    PRINT*,' QUILT I/O SERVER SHUTTING DOWN NOW'
    END SUBROUTINE QUILT
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
    SUBROUTINE DECOAL(A,LEN_CH)
    INCLUDE "COMM_BUFFER.f90"
    REAL :: A(*)

    IF(LEN_CH < 0)THEN
        IP=0
    ENDIF

    DO I=1,ABS(LEN_CH)
        IP=IP+1
        A(I)=BUF(IP)
    ENDDO

    END SUBROUTINE DECOAL

