SUBROUTINE chkout
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !                .      .    .
  ! 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
  !                           MODEL'S HYDROSTATIC EQUATION NEXT TO
  !                           MOUNTAIN SIDES)
  !   96-04-12  MIKE BALDWIN - MODIFIED SOUNDING OUTPUT
  !   96-10-31  T BLACK - MODIFICATIONS FOR GENERATIONS OF NEST'S BCs


  ! 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
  !                  SRFDSP
  !                  CNVCLD
  !                  CLDWTR
  !                  ACMCLD
  !                  ACMCLH
  !                  ACMPRE
  !                  ACMRDL
  !                  ACMRDS
  !                  ACMSFC
  !                  SOIL
  !                  PRFHLD
  !                  INDX
  !                  BCNEST

  !     INCLUDE/DECLARE PARAMETERS.
  IMPLICIT NONE
  INCLUDE "parmeta.f90"
  INCLUDE "parm.tbl.f90"
  !--------------------------------------------------------------------
  REAL :: a2,a3,a4,ad05,ai,alpha,alpint,alpp1
  REAL :: alpth,apests,bi,capa,cclimit,ccr
  REAL :: cft0,climit,cm1,cm2,cm3,cosalp
  REAL :: cosph0,ctim,ctim1,ctim2,cwmkl,d00
  REAL :: d0065,d05,d115,d125,d50,d608
  REAL :: dlm,dposp,dtr,egrid2,egrid3,egrid4
  REAL :: eps,erad,factr,fiq,fiw,gi
  REAL :: h1,h10,h1000,h10000,h1m5,h2
  REAL :: h4,hh,hshltr
  INTEGER :: i,iday,ifcst,ih,ihh2,ihr
  INTEGER :: ihr1,ihr2,iii,ijfm,im1,imjm
  INTEGER :: imjm1,imnt,imnth,imt,iputit,istat
  INTEGER :: istrt,iutim1,iutim2,iutima,iutimb,iv
  INTEGER :: iw,iwkl,iyr,j,jam,jh
  INTEGER :: jjj,jm2,jmnt,jmt,jv,k
  INTEGER :: kbi1,kbi2,khh00,khl00,km,kmm
  INTEGER :: kmn,kmntm,kount,ks,ksfi,kslpd
  INTEGER :: ksmud,ksslp,kst,l,l1,l2
  INTEGER :: l3,l4,la,lb,lcl0ml,lcl0sl
  INTEGER :: lcl1ml,lcl1sl,lhmnt,li,ll,llmh
  INTEGER :: lm1,lma,lmap1,lmhk,lml,lmst
  INTEGER :: lp1,lrjm,lscrch,lunin,lunot,lv
  INTEGER :: lvl,lxx,n,ninc,nlen,nn
  INTEGER :: nrlx,nrlx1,nrlx2,ns,nsoil,nstat
  INTEGER :: ntsph,nwgts1,nwgts2,nword10,nword11,nword12
  INTEGER :: nword13,nword2,nword3,nword4,nword5,nword6
  INTEGER :: nword7,nword8,nword9,nwordm
  INTEGER :: nlen1, n1, nm         !chou
  REAL :: fpctmp                   !chou
  REAL :: overrc,pacsnom
  REAL :: pacsnow,pbgroff,pbi,pbin,pds,pdsl
  REAL :: peta,phbi,phti,pi,pp,ppotevp
  REAL :: pq0,prbin,prec0,prlwin,prlwout,prlwtoa
  REAL :: prswin,prswout,prswtoa,prtin,psfcevp,psfcshx
  REAL :: psfcsub,pshltr,pslp,psnopcx,pssroff,pti
  REAL :: ptin,qc,qi,qint,qkl,qw
  REAL :: rog,rqkl,rtscu,rtsph,rtsra,sinalp
  REAL :: sinph0,slop,slp,slpp,smtha,smthb
  REAL :: spval,stacrx,staevx,staprx,sumt,swttc
  REAL :: term1,tgss,timbc,times,tinit
  REAL :: tkl,tll1,tlon,tmt0,tmt15,trtv
  REAL :: ttnd,ttt,ttv,u00kl,us,ut
  REAL :: utim,vt,xx,yy,zint
  PARAMETER (d50=.50,h1=1.0,h2=2.0,h4=4.0,d00=0.0  &
       , h1000=1000.,h1m5=1.e-5,d125=.125 , h10000=10000.,d115=0.115  &
       , d608=0.608,d05=.05,d0065=0.0065,rog=287.04/9.8  &
       , overrc=1.75,ad05=overrc*d05,cft0=overrc-h1,gi=1./9.8  &
       , capa=0.285896,dtr=1.745329E-2,erad=6.376E6  &
       , hshltr=2.,h10=10.,pi=3.14159265)

  PARAMETER (la=13,ksmud=4,kslpd=1,ksslp=2,ksfi=4,kst=2  &
       , imt=2*im-1,jmt=jm/2+1)

  PARAMETER (cm1=2937.4,cm2=4.9283,cm3=23.5518,eps=0.622  &
       , a2=17.2693882,a3=273.16,a4=35.86,pq0=379.90516)

  PARAMETER (nsoil=2)
  !--------------------------------------------------------------------

  !    PARMS FOR HOURLY PROFILER OUTPUT
  !      NSTAT - MAX NUMBER OF STATIONS
  !      NWORDM - DIMENSION OF OUTPUT ARRAY, MUST BE LARGE ENOUGH
  !          TO HOLD ALL VARIABLES FOR ANY CLASS OF OUTPUT
  !          (MAX NO MULTI-LAYER VARIABLES*LM + NO OF SINGLE LAYER VARS)
  !      LCL0ML - NUMBER OF MULTI-LAYER VARIABLES OUTPUT FOR CLASS 0
  !      LCL1ML - NUMBER OF MULTI-LAYER VARIABLES OUTPUT FOR CLASS 1
  !      LCL0SL - NUMBER OF SINGLE LAYER VARIABLES OUTPUT FOR CLASS 0
  !      LCL1SL - NUMBER OF SINGLE LAYER VARIABLES OUTPUT FOR CLASS 1

  !--------------------------------------------------------------------
  PARAMETER (nstat=1000,spval=-99999.0  &
       , lcl0ml=6,lcl0sl=19,lcl1ml=13,lcl1sl=45 , nwordm=(lcl1ml+1)*lm+2*lcl1sl)

  PARAMETER (im1=im-1,jm2=jm-2,jam=6+2*(jm-10)  &
       , imjm=im*jm-jm/2,ninc=2*im-1,imjm1=imjm-1 , khl00=1,khh00=imjm  &
       , lm1=lm-1,lp1=lm+1,lrjm=imjm-im+1 , lscrch=4*lm+1+la +1,lb=2*im+jm-3  &
       , l1=la+1,l2=la+lm+1,l3=la+lm+lp1+1,l4=la+3*lm+1  &
       , ijfm=2385,nrlx1=70,nrlx2=35 , smtha=-1.8E-4,smthb=16.)
  !--------------------------------------------------------------------

  !     DECLARE VARIABLES.

  !--------------------------------------------------------------------
  LOGICAL :: stdrd,onhour, exctdn      ! chou
  !--------------------------------------------------------------------
  CHARACTER (LEN=8) :: outjob
  CHARACTER (LEN=13) :: ASSIGN
  CHARACTER (LEN=4) :: astmrk,TMYY
  CHARACTER (LEN=35) :: submit         ! chou
  CHARACTER (LEN=32) :: label
  CHARACTER (LEN=80) :: line
  CHARACTER (LEN=1) :: line1(80)
  EQUIVALENCE  (line,line1)
  !--------------------------------------------------------------------
  DIMENSION kmntm (lm)  &
       ,pdsl  (im,jm),pbi   (im,jm),pti   (im,jm)  &
       ,pslp  (0:im+1,0:jm+1),ttv   (0:im+1,0:jm+1) &
       ,slp   (im,jm)  &
       ,pds   (im,jm)  &
       ,prec0 (im,jm)  &
       ,egrid2(im,jm),egrid3(im,jm),egrid4(im,jm)  &
       ,factr (im,jm),pshltr(im,jm)  &
       ,qi    (im,jm),qint  (im,jm),ccr(im,jm,lm),iw (im,jm,lm)  &
       ,ttnd  (im,jm,lm),swttc (im,jm,lm)  &
       ,imnt  (imjm,lm),jmnt  (imjm,lm),peta  (im,jm,lm)  &
       ,alpint(im,jm,lp1),zint  (im,jm,lp1)
  !--------------------------------------------------------------------
  REAL prodat(nwordm),fpack(nwordm)  &
       ,statpr(nstat),stacpr(nstat),staevp(nstat),stasfe(nstat)  &
       ,stapot(nstat),stashx(nstat),stasub(nstat),stapcx(nstat)  &
       ,staswi(nstat),staswo(nstat),stalwi(nstat),stalwo(nstat)  &
       ,stalwt(nstat),staswt(nstat),stasnm(nstat),stasrf(nstat)  &
       ,stabrf(nstat),stasno(nstat),dhcnvc(lm,nstat),dhrain(lm,nstat)  &
       ,stadhc(lm),stadhr(lm)
  !--------------------------------------------------------------------

  !     INCLUDE COMMON BLOCKS.

  !--------------------------------------------------------------------
  INCLUDE "outfil.f90"
  INCLUDE "ctlblk.f90"
  INCLUDE "loops.f90"
  INCLUDE "masks.f90"
  INCLUDE "mapot.f90"
  INCLUDE "vrbls.f90"
  INCLUDE "pvrbls.f90"
  INCLUDE "dynamd.f90"
  INCLUDE "phys2.f90"
  INCLUDE "boco.f90"
  INCLUDE "srfdsp.f90"
  INCLUDE "cnvcld.f90"
  INCLUDE "acmcld.f90"
  INCLUDE "acmclh.f90"
  INCLUDE "acmpre.f90"
  INCLUDE "acmrdl.f90"
  INCLUDE "acmrds.f90"
  INCLUDE "acmsfc.f90"
  INCLUDE "soil.f90"
  INCLUDE "prfhld.f90"
  INCLUDE "cldwtr.f90"
  INCLUDE "indx.f90"
  INCLUDE "bcnest.f90"
  !--------------------------------------------------------------------

  !     DECLARE EQUIVALENCES.

  !--------------------------------------------------------------------
  EQUIVALENCE (ttnd (1,1,1),swttc(1,1,1))



  !--------------------------------------------------------------------

  !     SET OUTPUT UNITS FOR CLASS 0 AND CLASS 1 PROFILE FILES.
  !      LCLAS0 - OUTPUT UNIT FOR CLASS 0 BINARY FILE
  !      LCLAS1 - OUTPUT UNIT FOR CLASS 1 BINARY FILE

  !--------------------------------------------------------------------
  INTEGER :: lclas0,lclas1
  !--------------------------------------------------------------------
  DATA lclas0, lclas1 / 75, 76 /  &
       ,nwgts1/40/,nwgts2/41/ ,iutima/51/,iutimb/52/,iutim1/61/,iutim2/62/
  !--------------------------------------------------------------------

  !     SAVE PROFILE AND OUTPUT FILE COUNTER BETWEEN CALLS.

  SAVE sinph0,cosph0
  SAVE statpr,stacpr,staevp,stapot,stashx,stasub,stapcx
  SAVE staswi,staswo,stalwi,stalwo,stalwt,staswt,stasnm
  SAVE stasrf,stabrf,stasfe,stasno,dhcnvc,dhrain
  SAVE iutima,iutimb,iutim1,iutim2,nwgts1,nwgts2
  !--------------------------------------------------------------------
  NAMELIST /POSTLIST/exctdn, submit    !chou
  !--------------------------------------------------------------------


  !***********************************************************************
  !***********************************************************************
  !     START CHKOUT HERE.
  !***********************************************************************
  !***********************************************************************

        IF (ntsd.eq.1) then                        !  chou
          READ(11,POSTLIST)                        !  chou
          WRITE(LIST,POSTLIST)                     !  chou
        ENDIF                                      !  chou
        
  !     UPDATE MAX AND MIN LOWEST LAYER TEMPS AT PROFILER SITES

  DO n=1,numsta
     i=ihindx(n)
     j=jhindx(n)
     lmhk=lmh(i,j)
     tll1=t(i,j,lmhk)
     IF(tll1 < tlmin(n))tlmin(n)=tll1
     IF(tll1 > tlmax(n))tlmax(n)=tll1
  END DO
  !***
  !***  FIGURE OUT JUST WHERE IN THE FORECAST WE ARE.
  !***
  ntsph=INT(3600./dt+d50)
  times=(ntsd-1)*dt
  onhour=.FALSE.
  IF((MOD(times,3600.) == 0.).OR. (MOD(times,3600.) > 3600.-dt))onhour=.TRUE.
  !***
  !------------------------------------------------------------------
  !***  IF WE ARE AT A REQUESTED OUTPUT TIME FOR BOUNDARY CONDITIONS
  !***  FOR AN INNER NEST, GENERATE THEM.
  !------------------------------------------------------------------
  !***
  IF(nest.AND.tbcex(kntbc) >= 0.)THEN
     timbc=3600.*(tbcex(kntbc)+tbegp)
     IF(NINT(timbc)-times < dt-0.01)THEN
!chou
!chou the lines below were moved to BCEX routine, header required tboco 
!chou        IF(kntbc == 1)THEN
!chou           WRITE(iutim1)run,idat,ihrst
!chou           WRITE(iutim2)run,idat,ihrst
!chou        END IF
        kbi1=2*imi1+jmi1-3
        CALL bcex(kntbc,tbcex,nwgts1,iutima,iutim1,tph0do,tlm0do  &
             ,             imi1,jmi1,lmi1,kbi1,tph0di1,tlm0di1)
        kbi2=2*imi2+jmi2-3
!chou        CALL bcex(kntbc,tbcex,nwgts2,iutimb,iutim2,tph0do,tlm0do  &
!chou             ,             imi2,jmi2,lmi2,kbi2,tph0di2,tlm0di2)
        kntbc=kntbc+1
     END IF
  END IF
  !***
  !------------------------------------------------------------------

  !     IF THE CURRENT FORECAST TIME IS A FULL HOUR OR EQUALS
  !     A FULL BLOWN POST TIME, THEN POST THE REQUESTED FIELDS.
  !     IF NOT, EXIT THIS ROUTINE.

  IF((ntsd == nshde).OR.onhour)GO TO 100
  RETURN

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

100 CONTINUE

  !     SET RTSPH,RTSCU,RTSRA TO 1. OVER THE NUMBER OF TIMES THE
  !     VARIOUS PHYSICS ROUTINES HAVE BEEN
  !     CALLED SINCE LAST OUTPUT OF PROFILER DATA.  NECESSARY FOR
  !     CORRECT AVERAGING OF VARIABLES.

  IF(aphtim > 0.)THEN
     rtsph=1./aphtim
  ELSE
     rtsph=1.
  END IF

  IF(acutim > 0.)THEN
     rtscu=1./acutim
  ELSE
     rtscu=1.
  END IF

  IF(aratim > 0.)THEN
     rtsra=1./aratim
  ELSE
     rtsra=1.
  END IF

  aphtim=0.
  acutim=0.
  aratim=0.

  !     SET PRESSURE CONSTANT AND FORECAST HOUR.

  alpth=ALOG(1.e5)
  ihr  =ntsd/tsph+.5

  !     THE PROFILES INCLUDE SEA LEVEL PRESSURE.  BELOW WE COMPUTE SEA
  !     LEVEL PRESSURE USING THE MESINGER REDUCTION ALGORITHM.  THE
  !     NEW POST PROCESSOR INCLUDES A SECOND REDUCTION ALGORITHM, THE
  !     STANDARD NMC SCHEME.  THE CODE BETWEEN HERE AND THE CALL TO
  !     ETAPOST3 IS FROM THE OLD SUBROUTINE OUTMAP.  FOR THE MOST PART

  !     INITIALIZE ARRAYS.  LOAD SLP ARRAY WITH SURFACE PRESSURE.

  CALL zero2(pslp)
  CALL zero2(ttv)
  !cmic$ do all vector autoscope
  DO  j=1,jm
     DO  i=1,im
        pdsl(i,j)=res(i,j)*pd(i,j)
        pslp(i,j)=pd(i,j)+pt
        pbi (i,j)=pslp(i,j)
     END DO
  END DO

  !     CALCULATE SEA LEVEL PRESSURE FOR PROFILES (AND POSSIBLY
  !     FOR POSTING BY POST PROCESSOR).

  !     DECIDE WHETHER TO USE THE "STANDARD" SLP REDUCTION SCHEME.
  !     THIS IS THE ONLY SCHEME AT PRESENT AVAILABLE FOR A SIGMA=.TRUE.
  !     ETA MODEL RUN.

  stdrd=.FALSE.
  IF(sigma)THEN
     stdrd=.TRUE.
     GO TO 400
  END IF
  IF(stdrd)GO TO 400

  !     WE REACH THIS LINE IF WE WANT THE "NEW" ETA SLP REDUCTION
  !     BASED ON RELAXATION TEMPERATURES.  THE FIRST STEP IS TO
  !     FIND THE HIGHEST LAYER CONTAINING MOUNTAINS.

  loop210:  DO  l=lm,1,-1
     DO  j=1,jm
        DO  i=1,im
           IF(htm(i,j,l) == d00)CYCLE loop210
        END DO
     END DO
     lhmnt=l+1
     EXIT loop210
  END DO loop210
220 IF(lhmnt == lp1)THEN
     GO TO 430
  END IF

  !     NOW GATHER THE ADDRESSES OF ALL THE UNDERGROUND POINTS.

  !mic$ do all autoscope
  DO  l=lhmnt,lm
     kmn=0
     kmntm(l)=0
     kount=0
     DO  j=3,jm-2
        DO  i=2,im-1
           kount=kount+1
           imnt(kount,l)=0
           jmnt(kount,l)=0
           IF(htm(i,j,l) == h1)CYCLE
           kmn=kmn+1
           imnt(kmn,l)=i
           jmnt(kmn,l)=j
        END DO
     END DO
     kmntm(l)=kmn
  END DO

  !     AS THE FIRST GUESS, SET THE UNDERGROUND TEMPERATURES EQUAL
  !     TO THE VALUE GIVING PD/ETAS+PT AS SEA LEVEL PRESSURE.

  IF(ntsd == 1)THEN
     kmm=kmntm(lm)
     !mic$ do all autoscope
     !mic$* shared (t)
     !HOU increasing loopcount length
!CDIR LOOPCNT=30000     !chou
     DO  km=1,kmm
        i=imnt(km,lm)
        j=jmnt(km,lm)
        tgss=fis(i,j)/(r*ALOG((pdsl(i,j)+pt)/(pd(i,j)+pt)))
        lmap1=lmh(i,j)+1
        DO  l=lmap1,lm
           t(i,j,l)=tgss
        END DO
     END DO
  END IF

  !     CREATE A TEMPORARY TV ARRAY, AND FOLLOW BY SEQUENTIAL
  !     OVERRELAXATION, DOING NRLX PASSES.

  !mic$ do all autoscope
  !mic$* private (ttv)
  DO  l=lhmnt,lm

     DO  j=1,jm
        DO  i=1,im
           ttv(i,j)=t(i,j,l)
        END DO
     END DO

     !     FOR GRID BOXES NEXT TO MOUNTAINS REPLACE ttv BY AN "EQUIVALENT"
     !     TV, ONE WHICH CORRESPONDS TO THE CHANGE IN P BETWEEN REFERENCE
     !     INTERFACE GEOPOTENTIALS, INSTEAD OF BETWEEN LAYER INTERFACES

     DO j=3,jm-2
        DO i=2,im-1
           IF(htm(i,j,l) == h1 .AND. htm(i+ihw(j),j-1,l)*htm(i+ihe(j),j-1,l)  &
                *htm(i+ihw(j),j+1,l)*htm(i+ihe(j),j+1,l)  &
                *htm(i-1     ,j  ,l)*htm(i+1     ,j  ,l)  &
                *htm(i       ,j-2,l)*htm(i       ,j+2,l) == d00)THEN
              lmst=lmh(i,j)
              !***
              !***  FIND P AT THE REFERENCE INTERFACE GEOPOTENTIAL AT THE BOTTOM
              !***
              pbin=pt+pd(i,j)
              phbi=dfl(lmst+1)
              DO li=lmst,1,-1
                 ptin=pbin-deta(li)*pd(i,j)*res(i,j)
                 trtv=h2*r*t(i,j,li)*(h1+d608*q(i,j,li))
                 phti=phbi+trtv*(pbin-ptin)/(pbin+ptin)
                 IF(phti >= dfl(l+1))GO TO 273
                 pbin=ptin
                 phbi=phti
              END DO
273           dposp=(phti-dfl(l+1))/trtv
              prbin=(h1+dposp)/(h1-dposp)*ptin
              !***
              !***  FIND P AT THE REFERENCE INTERFACE GEOPOTENTIAL AT THE TOP
              !***
              pbin=pt+pd(i,j)
              phbi=dfl(lmst+1)
              DO li=lmst,1,-1
                 ptin=pbin-deta(li)*pd(i,j)*res(i,j)
                 trtv=h2*r*t(i,j,li)*(h1+d608*q(i,j,li))
                 phti=phbi+trtv*(pbin-ptin)/(pbin+ptin)
                 IF(phti >= dfl(l))GO TO 275
                 pbin=ptin
                 phbi=phti
              END DO
275           dposp=(phti-dfl(l))/trtv
              prtin=(h1+dposp)/(h1-dposp)*ptin

              ttv(i,j)=(dfl(l)-dfl(l+1))/(h2*r)*(prbin+prtin)/(prbin-prtin)
           END IF
        END DO
     END DO

     kmm=kmntm(l)
     IF(ntsd == 1)THEN
        nrlx=nrlx1
     ELSE
        nrlx=nrlx2
     END IF

     DO  n=1,nrlx
        !     IF(L.EQ.LM)DLTMX=0.
        !HOU increasing loopcount length
!CDIR LOOPCNT=30000
        DO  km=1,kmm
           i=imnt(km,l)
           j=jmnt(km,l)
           tinit=ttv(i,j)
           ttv(i,j)=ad05*(h4*(ttv(i+ihw(j),j-1)+ttv(i+ihe(j),j-1)  &
                +ttv(i+ihw(j),j+1)+ttv(i+ihe(j),j+1)) +ttv(i-1,j)       +ttv(i+1,j)  &
                +ttv(i,j-2)       +ttv(i,j+2)) -cft0*ttv(i,j)

           !     IF(L.EQ.LM)THEN
           !       DLTT=ABS(TTV(I,J)-TINIT)
           !       IF(DLTT.GT.DLTMX)DLTMX=DLTT
           !     ENDIF
        END DO
        !     IF(L.EQ.LM)WRITE(51,2302)N,DLTMX
        !2302 FORMAT(' ',I5,E10.3)
     END DO


     !HOU increasing loopcount length
!CDIR LOOPCNT=30000
     DO  km=1,kmm
        i=imnt(km,l)
        j=jmnt(km,l)
        t(i,j,l)=ttv(i,j)
     END DO
  END DO

  !     CALCULATE THE SEA LEVEL PRESSURE AS PER THE NEW SCHEME.

  kmm=kmntm(lm)
  !mic$ do all autoscope
  !mic$* shared (pslp)
  !HOU increasing loopcount length
!CDIR LOOPCNT=30000
  DO  km=1,kmm
     i=imnt(km,lm)
     j=jmnt(km,lm)
     lmap1=lmh(i,j)+1
     pbin=pt+pd(i,j)

     DO  l=lmap1,lm
        ptin=pbin
        dposp=(dfl(l)-dfl(l+1))/(h2*r*t(i,j,l))
        pbin=(h1+dposp)/(h1-dposp)*ptin
     END DO

     pslp(i,j)=pbin
  END DO

  !     SKIP THE STANDARD SCHEME.

  GO TO 430

  !     IF YOU WANT THE "STANDARD" ETA/SIGMA REDUCTION
  !     THIS IS WHERE IT'S DONE.

400 CONTINUE
  DO  j=1,jm
     DO  i=1,im
        IF(fis(i,j) >= h1)THEN
           lma=lmh(i,j)
           alpp1=ALOG(pdsl(i,j)*eta(lma+1)+pt)
           slop=d0065*rog*t(i,j,lma)
           IF(slop < d50)THEN
              slpp=alpp1+fis(i,j)/(r*t(i,j,lma))
           ELSE
              ttt=-(ALOG(pdsl(i,j)*eta(lma)+pt)+alpp1) *slop*d50+t(i,j,lma)
              slpp=(-ttt+SQRT(ttt*ttt+h2*slop* (fis(i,j)/r+  &
                   (ttt+d50*slop*alpp1)*alpp1)))/slop
           END IF
           pslp(i,j)=EXP(slpp)
        END IF
     END DO
  END DO

  !****************************************************************
  !     AT THIS POINT WE HAVE A SEA LEVEL PRESSURE FIELD BY
  !     EITHER METHOD.  5-POINT AVERAGE THE FIELD ON THE E-GRID.
  !****************************************************************

430 CONTINUE

  !MIC$ DO ALL VECTOR AUTOSCOPE
  DO  j=1,jm
     DO  i=1,im
        slp(i,j)=pslp(i,j)
     END DO
  END DO

  DO  ks=1,kslpd
     DO  j=3,jm2
        ihh2=im-1-MOD(j+1,2)
        DO  i=2,ihh2
           !  EXTRA AVERAGING UNDER MOUNTAINS TAKEN OUT, FM, MARCH 96
           slp(i,j)=d125*(pslp(i+ihw(j),j-1)+pslp(i+ihe(j),j-1)  &
                +pslp(i+ihw(j),j+1)+pslp(i+ihe(j),j+1) +h4*pslp(i,j))
        END DO
     END DO

     DO  j=1,jm
        DO  i=1,im
           pslp(i,j)=slp(i,j)
        END DO
     END DO
  END DO

  !--------------------------------------------------------------------
  !     WE'RE DONE WITH THE SEA LEVEL PRESSURE CALCULATION.  IN THE
  !     PROCESS WE CREATED UNDERGROUND VIRTUAL TEMPERATURES.
  !--------------------------------------------------------------------

  !***
  !***  CALCULATE CLOUD FRACTION AND CLOUD WATER/ICE ID NUMBER
  !***

  !  SET UP UTIM FOR THIS TIME STEP

  ctim1=0.
  ctim2=24.*3600.
  ctim =ntsd*dt
  IF(ctim < ctim1)THEN
     utim=0.
  ELSE
     IF(ctim <= ctim2)THEN
        utim=(ctim-ctim1)/(ctim2-ctim1)
     ELSE
        utim=1.
     END IF
  END IF
  us=h1
  cclimit=1.e-3
  climit =1.e-20
  !-----------------------------------------------------------------------
  DO  j=1,jm
     DO  i=1,im
        iw(i,j,1)=0
        ccr(i,j,1)=0.
     END DO
  END DO

  !------------------QW, QI AND QINT--------------------------------------

  DO  l=2,lm
     DO  j=1,jm
        DO  i=1,im
           lml=lm-lmh(i,j)
           hh=htm(i,j,l)*hbm2(i,j)
           tkl=t(i,j,l)
           qkl=q(i,j,l)
           cwmkl=cwm(i,j,l)
           tmt0=(tkl-273.16)*hh
           tmt15=AMIN1(tmt0,-15.)*hh
           ai=0.008855
           bi=1.
           IF(tmt0 < -20.)THEN
              ai=0.007225
              bi=0.9674
           END IF
           pp=pdsl(i,j)*aeta(l)+pt
           qw=hh*pq0/pp*EXP(hh*a2*(tkl-a3)/(tkl-a4))
           qi(i,j)=qw*(bi+ai*AMIN1(tmt0,0.))
           qint(i,j)=qw*(1.-0.00032*tmt15*(tmt15+15.))
           IF(tmt0 <= -40.)qint(i,j)=qi(i,j)

           !-------------------ICE-WATER ID NUMBER IW------------------------------

           u00kl=u00(i,j)+ul(l+lml)*(0.95-u00(i,j))*utim
           IF(tmt0 < -15.0)THEN
              fiq=qkl-u00kl*qi(i,j)
              IF(fiq > d00.OR.cwmkl > climit)THEN
                 iw(i,j,l)=1
              ELSE
                 iw(i,j,l)=0
              END IF
           END IF

           IF(tmt0 >= 0.)THEN
              iw(i,j,l)=0
           END IF

           IF(tmt0 < 0..AND.tmt0 >= -15.)THEN
              iw(i,j,l)=0
              IF(iw(i,j,l-1) == 1.AND.cwmkl > climit)iw(i,j,l)=1
           END IF

           iwkl=iw(i,j,l)
           !----------------THE SATUATION SPECIFIC HUMIDITY------------------------
           fiw=FLOAT(iwkl)
           qc=(h1-fiw)*qint(i,j)+fiw*qi(i,j)
           !----------------THE RELATIVE HUMIDITY----------------------------------
           IF(qc <= d00)THEN
              rqkl=d00
           ELSE
              rqkl=qkl/qc
           END IF
           !----------------CLOUD COVER RATIO CCR----------------------------------
           IF(rqkl >= 0.9999)THEN
              ccr(i,j,l)=AMIN1(us,rqkl)
           ELSE
              ccr(i,j,l)=rqkl*(h1-EXP((-1000.0*cwmkl)/(us-rqkl)))
           END IF
           !----------------------------------------------------------------------
        END DO
     END DO
  END DO
  !----------------------------------------------------------------------

  !***
  !***  FIND ANEMOMETER LEVEL WINDS, THETA, AND Q AND
  !***  THE SHELTER LEVEL TEMPERATURE AND Q
  !***
  DO j=1,jm
     DO i=1,im
        pdsl(i,j)=pd(i,j)*res(i,j)
     END DO
  END DO

  !mic$ do all autoscope
  !mic$* private (pti)
  DO  l=lp1,1,-1
     DO  j=1,jm
        DO  i=1,im
           pti(i,j)=pdsl(i,j)*eta(l)+pt
           alpint(i,j,l)=ALOG(pti(i,j))
        END DO
     END DO
  END DO

  DO  j=1,jm
     DO  i=1,im
        zint(i,j,lp1)=0.
     END DO
  END DO
  DO  l=lm,1,-1
     !mic$ do all autoscope
     DO  j=1,jm
        DO  i=1,im
           apests=pdsl(i,j)*aeta(l)+pt
           zint(i,j,l)=t(i,j,l)*pdsl(i,j)*deta(l)*rog*(q(i,j,l)*.608+1.)  &
                /apests+zint(i,j,l+1)
           zint(i,j,l)=(zint(i,j,l)-dfrlg(l))*htm(i,j,l)+dfrlg(l)
        END DO
     END DO
  END DO


  !     START PROFILE POSTING CODE.

  !     ON THE FIRST TIMESTEP WE MUST READ IN STATION DATA FOR
  !     THE PROFILES AND, OPTIONALLY, FOR THE DIAGNOSTIC POINTS.
  !     THIS INFORMATION IS  SAVED BETWEEN CALLS TO THIS ROUTINE.

  IF(ntsd < 2)THEN
     DO n=1,numsta

        !           ZERO ACCUMLATION ARRAYS.

        statpr(n) = d00
        stacpr(n) = d00
        staevp(n) = d00
        stasfe(n) = d00
        stapot(n) = d00
        stashx(n) = d00
        stasub(n) = d00
        stapcx(n) = d00
        staswi(n) = d00
        staswo(n) = d00
        stalwi(n) = d00
        stalwo(n) = d00
        stalwt(n) = d00
        staswt(n) = d00
        stasnm(n) = d00
        stasno(n) = d00
        stasrf(n) = d00
        stabrf(n) = d00
        DO l=1,lm
           dhcnvc(l,n) = d00
           dhrain(l,n) = d00
        END DO

        !        ENDDO FOR LOOP READING STATION LIST.
     END DO

     !        FOR ROTATION OF WINDS FROM E-GRID TO GEODETIC ORIENTATION
     !        WE NEED THE TWO QUANTITIES BELOW.  COMPUTE ONCE AND SAVE.

     sinph0=SIN(tph0d*dtr)
     cosph0=COS(tph0d*dtr)
  END IF

  !     INITIAL CALCULATIONS/PREPARATIONS.  WE LOAD SEVERAL
  !     ARRAYS WITH PROFILE VARIABLES.

  !     PDS IS SURFACE PRESSURE.
  !     TSHLTR HOLDS THE 2M THETA, CONVERT TO TEMP AND ALSO
  !     LOAD UP PSHLTR.  TERM1 IS 2m*G/(Rd*T)

  !mic$ do all autoscope
  DO j=1,jm
     DO i=1,im
        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)*h1m5)**capa
        IF(czmean(i,j) > 0.)THEN
           factr(i,j)=czen(i,j)/czmean(i,j)
        ELSE
           factr(i,j)=0.
        END IF

        !   MAKE SURE POST DOES NOT BLOW UP WHEN COMPUTING RH ON BNDRY

        IF (j < 3) THEN
           tshltr(i,j)=tshltr(i,3)
           qshltr(i,j)=qshltr(i,3)
        END IF
        IF (j > jm-2) THEN
           tshltr(i,j)=tshltr(i,jm-2)
           qshltr(i,j)=qshltr(i,jm-2)
        END IF
     END DO
  END DO

  !     PETA IS THE LAYER MIDPOINT PRESSURE.
  !     SWTTC IS THE CURRENT SW TEMP TENDENCIES.

  !mic$ do all autoscope
  DO l=1,lm
     DO j=1,jm
        DO i=1,im
           peta(i,j,l)=pdsl(i,j)*aeta(l)+pt
           swttc(i,j,l)=rswtt(i,j,l)*factr(i,j)
        END DO
     END DO
  END DO

  !     EGRID2 IS THE SURFACE TEMPERATURE.  EGRID3 AND 4 ARE
  !     THE ACCUMLATED TOTAL AND CONVECTIVE PRECIPITATION,
  !     RESPECTIVELY.

  DO j=1,jm
     DO i=1,im
        egrid2(i,j)= ths(i,j)*(pds(i,j)*h1m5)**capa
        egrid3(i,j)= acprec(i,j)
        egrid4(i,j)= cuprec(i,j)
        prec0(i,j) = d00
        IF(egrid3(i,j) < prec0(i,j))egrid3(i,j)=d00
        IF(egrid4(i,j) < prec0(i,j))egrid4(i,j)=d00
     END DO
  END DO

  !     SET CYCLE, DATE, AND FORECAST TIME.

  ihr  =ntsd/ntsph+0.5
  iyr  =idat(3)-1900
  imnth=idat(1)
  iday =idat(2)
  ifcst=(ntsd-1)*dt

  WRITE(list,*)'CHKOUT:  POST PROFILE FOR ',iyr,imnth,iday,ihr


  !     OUTPUT PROFILE DATA.  THE BIG LOOP IS OVER PROFILE SITES.

  DO ns=1,numsta

     !        ZERO OUTPUT ARRAY.

     DO k=1,nwordm
        prodat(k)=d00
        fpack(k) =d00
     END DO

     !        CONSTRUCT HEADER FOR CURRENT PROFILE SITE.  THE HEADER CONTAINS
     !        THE FOLLOWING INFORMATION:  PACKED CYCLE-DATE, FORECAST TIME,
     !        INTEGER STATION ID, STATION LATITUDE, STATION LONGITUDE, STATION
     !        ELEVATION, NUMBER OF VERTICAL LEVELS IN PROFILE, NUMBER OF MULTI-
     !        LEVEL PARAMETERS, NUMBER OF SINGLE LEVEL PARAMETERS, TOTAL LENGTH
     !        (IN WORDS) OF MULTI- AND SINGLE LEVEL DATA, PROFILE CLASS FLAG,
     !        AND A DUMMY WORD FOR FUTURE USE.

     ih=ihindx(ns)
     jh=jhindx(ns)
     iv=ivindx(ns)
     jv=jvindx(ns)
     lmhk     = lmh(ih,jh)
     nword2   = 2*lmhk
     nword3   = 3*lmhk
     nword4   = 4*lmhk
     nword5   = 5*lmhk
     nword6   = 6*lmhk
     nword7   = 7*lmhk
     nword8   = 8*lmhk
     nword9   = 9*lmhk
     nword10  = 10*lmhk
     nword11  = 11*lmhk
     nword12  = 12*lmhk
     nword13  = 13*lmhk
     istat    = idstn(ns)
     fpack(1) = stnlat(ns)/dtr
     fpack(2) = -1.0*stnlon(ns)/dtr
     IF(fpack(2) < -180.)fpack(2)=fpack(2)+360.
     fpack(3) = fis(ih,jh)*gi
     fpack(4) = FLOAT(lmhk)
     IF ( (kclass(ns) == 0) .OR. (kclass(ns) == 2) ) THEN
        fpack(5) = lcl0ml
        fpack(6) = lcl0sl
        fpack(7) = 9 + fpack(5)*fpack(4) + fpack(6)
     ELSE IF (kclass(ns) == 1) THEN
        fpack(5) = lcl1ml
        fpack(6) = lcl1sl
        fpack(7) = 9 + fpack(5)*fpack(4) + fpack(6)
     END IF
     fpack(8) = kclass(ns)
     fpack(9) = 999.

     !        WE HAVE TWO CLASSES OF PROFILES.  THEY DIFFER BY THE VARIABLES
     !        CONTAINED IN THE PROFILES DATASET.  CLASS 0 PROFILES CONTAIN
     !        THE OLD, STANDARD LIST OF PROFILE FIELDS.  CLASS 1 PROFILES
     !        CONTAIN THE STANDARD LIST OF PROFILE FIELDS PLUS DIAGNOSTIC
     !        QUANTITIES.  CLASS 1 SITES WERE INTRODUCED TO SATISFY GCIP
     !        REQUIREMENTS.  CLASS 0 AND 1 PROFILES ARE WRITTEN TO SEPARATE
     !        OUTPUT FILES.  ADDITIONALLY WE HAVE CLASS 2 SITES WHICH SIMPLY
     !        MEANS TO POST A CLASS 0 AND A CLASS 1 PROFILE FOR THE SAME SITE.
     !        BELOW WE PROCESS EACH STATION ACCORDING TO IT'S CLASS SETTING.

     !        EXTRACT, PACK, AND POST DATA FOR CLASS 0 OR 2 PROFILE SITES.
     IF((kclass(ns) == 0).OR.(kclass(ns) == 2))THEN

        !           RESET CLASS TYPE TO 0 FOR CLASS 2 SITES.
        IF(kclass(ns) == 2)fpack(8)=0

        !           EXTRACT PRESSURE AND TEMPERATURE PROFILES,
        !           EXTRACT/ROTATE U AND V WIND COMPONENT PROFILES,
        !           EXTRACT SPECIFIC HUMIDITY PROFILES,
        !           WRITE OUT PROFILES FROM BOTTOM UP (REVERSE ORDER FROM MODEL).

        DO lv=1,lmhk
           lvl=lmhk-lv+1
           prodat(lvl)     =peta(ih,jh,lv)
           prodat(lmhk+lvl)=t(ih,jh,lv)

           dlm    = stnlon(ns)+tlm0d*dtr
           xx     = cosph0*COS(stnlat(ns))*COS(dlm) +sinph0*SIN(stnlat(ns))
           yy     = -COS(stnlat(ns))*SIN(dlm)
           tlon   = ATAN(yy/xx)
           alpha  = ASIN(sinph0*SIN(tlon)/COS(stnlat(ns)))
           sinalp = SIN(alpha)
           cosalp = COS(alpha)
           ut     = u(iv,jv,lv)
           vt     = v(iv,jv,lv)
           prodat(nword2+lvl) = ut*cosalp+vt*sinalp
           prodat(nword3+lvl) = vt*cosalp-ut*sinalp

           prodat(nword4+lvl) = q(ih,jh,lv)
           prodat(nword5+lvl) = omghld(ns,lv)
        END DO

        !           EXTRACT SINGLE LEVEL DATA.   EGRID2 IS SURFACE TEMPERATURE.
        !           EGRID3 IS (ACCUMULATED) TOTAL PRECIP.  EGRID4 IS (ACCUMULATED)
        !           CONVECTIVE PRECIP. EGRID1 IS THE MOISTURE AVAILABILITY.

        prodat(nword6+1)  = slp   (ih,jh)
        prodat(nword6+2)  = pds   (ih,jh)
        prodat(nword6+3)  = egrid2(ih,jh)
        prodat(nword6+4)  = stc   (ih,jh,1)
        prodat(nword6+5)  = sfcevp(ih,jh)*1000.
        prodat(nword6+6)  = smstav(ih,jh)*100.
        prodat(nword6+7)  = egrid3(ih,jh)*1000.
        prodat(nword6+8)  = egrid4(ih,jh)*1000.
        prodat(nword6+9)  = sno   (ih,jh)*1000.
        prodat(nword6+10) = cfracl(ih,jh)*100.
        prodat(nword6+11) = cfracm(ih,jh)*100.
        prodat(nword6+12) = cfrach(ih,jh)*100.
        prodat(nword6+13) = sm    (ih,jh)
        prodat(nword6+14) = u10   (ih,jh)
        prodat(nword6+15) = v10   (ih,jh)
        prodat(nword6+16) = ssroff(ih,jh)*1000.
        prodat(nword6+17) = bgroff(ih,jh)*1000.
        prodat(nword6+18) = tshltr(ih,jh)
        prodat(nword6+19) = qshltr(ih,jh)

        !           MODIFY ACCUMULATIONS SO AS TO REPRESENT ACCUMULATED
        !           CHANGE SINCE LAST PROFILE OUTPUT TIME.
        staevx     = prodat(nword6+5) - stasfe(ns)
        stasfe(ns) = prodat(nword6+5)
        IF (MOD(ntsd,nprec) < nphs) stasfe(ns) = d00

        staprx     = prodat(nword6+7) - statpr(ns)
        statpr(ns) = prodat(nword6+7)
        IF (MOD(ntsd,nprec) < nphs) statpr(ns) = d00

        stacrx     = prodat(nword6+8) - stacpr(ns)
        stacpr(ns) = prodat(nword6+8)
        IF (MOD(ntsd,nprec) < nphs) stacpr(ns) = d00

        pssroff    = prodat(nword6+16) - stasrf(ns)
        stasrf(ns) = prodat(nword6+16)
        IF (MOD(ntsd,nprec) < nphs) stasrf(ns) = d00

        pbgroff    = prodat(nword6+17) - stabrf(ns)
        stabrf(ns) = prodat(nword6+17)
        IF (MOD(ntsd,nprec) < nphs) stabrf(ns) = d00

        !           TRANSFER STATION PROFILE DATA TO "PACKED" OUTPUT ARRAY.

        nn   = 0
        nlen = fpack(7)
        DO n = 10,nlen
           nn = n-9
           fpack(n) = prodat(nn)
        END DO

        !           REPLACE ACCUMULATED QUANTITIES WITH ACCUMULATION
        !           SINCE LAST PROFILE OUTPUT TIME.

        IF(staevx >= 0.0) THEN
           fpack(9+nword6+5) = staevx
        ELSE
           fpack(9+nword6+5) = d00
        END IF
        fpack(9+nword6+7) = staprx
        fpack(9+nword6+8) = stacrx
        fpack(9+nword6+16) = pssroff
        fpack(9+nword6+17) = pbgroff

        !           WRITE DATA FOR CLASS 0 OR 2 SITE.
        WRITE(lclas0) ihrst,idat,ifcst,istat,(fpack(n),n=1,nlen)


        !        END OF IF BLOCK FOR CLASS 0 OR CLASS 2 SITE.

     END IF

     !        EXTRACT, PACK, AND POST DATA FOR CLASS 1 OR 2 SITES.

     IF((kclass(ns) == 1).OR.(kclass(ns) == 2))THEN

        !           RESET RECORD LENGTH PARAMETERS IN HEADER FOR CLASS 2 SITES.
        IF(kclass(ns) == 2)THEN
           fpack(5) = lcl1ml
           fpack(6) = lcl1sl
           fpack(7) = 9 + fpack(5)*fpack(4) + fpack(6)
           fpack(8) = 1
        END IF

        !           EXTRACT PRESSURE AND TEMPERATURE PROFILES.
        !           EXTRACT/ROTATE U AND V WIND COMPONENT PROFILES.
        !           EXTRACT SPECIFIC HUMIDITY AND TEMPERATURE TENDENCY

        !           EXTRACT CLOUD WATER, HEATING DUE TO CONVECTION, LARGE
        !           SCALE RAIN, SHORT WAVE RADIATION, LONG WAVE RADIATION,
        !           AND CLOUD FRACTION AT CLASS 1 PROFILE SITES.
        DO lv = 1,lmhk
           lvl=lmhk-lv+1
           prodat(lvl)      = peta(ih,jh,lv)
           prodat(lmhk+lvl) = t(ih,jh,lv)

           dlm    = stnlon(ns)+tlm0d*dtr
           xx     = cosph0*COS(stnlat(ns))*COS(dlm)+ sinph0*SIN(stnlat(ns))
           yy     = -COS(stnlat(ns))*SIN(dlm)
           tlon   = ATAN(yy/xx)
           alpha  = ASIN(sinph0*SIN(tlon)/COS(stnlat(ns)))
           sinalp = SIN(alpha)
           cosalp = COS(alpha)
           ut     = u(iv,jv,lv)
           vt     = v(iv,jv,lv)
           prodat(nword2+lvl) = ut*cosalp+vt*sinalp
           prodat(nword3+lvl) = vt*cosalp-ut*sinalp
           prodat(nword4+lvl) = q(ih,jh,lv)
           prodat(nword5+lvl) = omghld(ns,lv)
           prodat(nword6+lvl) = cwm(ih,jh,lv)
           prodat(nword7+lvl) = tcucn(ih,jh,lv)
           prodat(nword8+lvl) = train(ih,jh,lv)
           prodat(nword9+lvl) = swttc(ih,jh,lv)
           prodat(nword10+lvl)= rlwtt(ih,jh,lv)
           prodat(nword11+lvl)= ccr(ih,jh,lv)*100.
           IF (lv == 1) THEN
              prodat(nword12+lvl)= q2(ih,jh,lv)
           ELSE
              prodat(nword12+lvl)= (q2(ih,jh,lv)+q2(ih,jh,lv-1))*0.5
           END IF
        END DO

        !              MODIFY ACCUMLATIONS SO AS TO REPRESENT ACCUMULATED
        !              CHANGE SINCE LAST PROFILE OUTPUT TIME.

        DO ll = 1,lmhk
           stadhc(ll) = prodat(nword7+ll) - dhcnvc(ll,ns)
           stadhr(ll) = prodat(nword8+ll) - dhrain(ll,ns)

           dhcnvc(ll,ns) = prodat(nword7+ll)
           dhrain(ll,ns) = prodat(nword8+ll)

           IF(MOD(ntsd,nheat) < ncnvc)THEN
              dhcnvc(ll,ns) = d00
              dhrain(ll,ns) = d00
           END IF
        END DO

        !           EXTRACT SINGLE LEVEL DATA.   EGRID2 IS SURFACE TEMPERATURE.
        !           EGRID3 IS (ACCUMULATED) TOTAL PRECIP.  EGRID4 IS (ACCUMULATED)
        !           CONVECTIVE PRECIP. EGRID1 IS THE MOISTURE AVAILABILITY.

        prodat(nword13+1)  = slp   (ih,jh)
        prodat(nword13+2)  = pds   (ih,jh)
        prodat(nword13+3)  = egrid2(ih,jh)
        prodat(nword13+4)  = tlmin (ns)
        prodat(nword13+5)  = tlmax (ns)
        prodat(nword13+6)  = smstav(ih,jh)*100.
        prodat(nword13+7)  = egrid3(ih,jh)*1000.
        prodat(nword13+8)  = egrid4(ih,jh)*1000.
        prodat(nword13+27) = z0    (ih,jh)
        prodat(nword13+28) = u10   (ih,jh)
        prodat(nword13+29) = v10   (ih,jh)
        prodat(nword13+30) = th10  (ih,jh)
        prodat(nword13+31) = q10   (ih,jh)
        prodat(nword13+32) = tshltr(ih,jh)
        prodat(nword13+33) = qshltr(ih,jh)
        prodat(nword13+34) = sfcexc(ih,jh)
        prodat(nword13+35) = vegfrc(ih,jh)*100.
        prodat(nword13+36) = cmc   (ih,jh)*1000.
        prodat(nword13+37) = smc   (ih,jh,1)
        prodat(nword13+38) = stc   (ih,jh,1)
        prodat(nword13+39) = smc   (ih,jh,2)
        prodat(nword13+40) = stc   (ih,jh,2)
        prodat(nword13+41) = sm    (ih,jh)
        prodat(nword13+42) = cfracl(ih,jh)*100.
        prodat(nword13+43) = cfracm(ih,jh)*100.
        prodat(nword13+44) = cfrach(ih,jh)*100.
        prodat(nword13+45) = sr    (ih,jh)*100.

        !           MODIFY PRECIPITATION ACCUMULATIONS SO AS TO REPRESENT

        IF (kclass(ns) /= 2) THEN
           staprx     = prodat(nword13+7)  - statpr(ns)
           stacrx     = prodat(nword13+8)  - stacpr(ns)
           statpr(ns) = prodat(nword13+7)
           stacpr(ns) = prodat(nword13+8)
           IF(MOD(ntsd,nprec) < nphs)THEN
              statpr(ns) = d00
              stacpr(ns) = d00
           END IF
        END IF

        prodat(nword13+9)   = sfclhx(ih,jh)
        prodat(nword13+10)  = potflx(ih,jh)
        prodat(nword13+11)  = sfcshx(ih,jh)
        prodat(nword13+12)  = subshx(ih,jh)
        prodat(nword13+13)  = snopcx(ih,jh)
        prodat(nword13+14)  = aswin (ih,jh)
        prodat(nword13+15)  = aswout(ih,jh)
        prodat(nword13+16)  = alwin (ih,jh)
        prodat(nword13+17)  = alwout(ih,jh)
        prodat(nword13+18)  = -1.0*alwtoa(ih,jh)
        prodat(nword13+19)  = aswtoa(ih,jh)
        prodat(nword13+20)  = acsnow(ih,jh)*1000.
        prodat(nword13+21)  = smstot(ih,jh)*1000.
        prodat(nword13+22)  = sno   (ih,jh)*1000.
        prodat(nword13+23)  = acsnom(ih,jh)*1000.
        prodat(nword13+24)  = ssroff(ih,jh)*1000.
        prodat(nword13+25)  = bgroff(ih,jh)*1000.
        prodat(nword13+26)  = soiltb(ih,jh)

        !              MODIFY ACCUMULATIONS SO AS TO REPRESENT ACCUMULATED
        !              CHANGE SINCE LAST PROFILE OUTPUT TIME.

        psfcevp  = prodat(nword13+9 ) - staevp(ns)
        ppotevp  = prodat(nword13+10) - stapot(ns)
        psfcshx  = prodat(nword13+11) - stashx(ns)
        psfcsub  = prodat(nword13+12) - stasub(ns)
        psnopcx  = prodat(nword13+13) - stapcx(ns)
        prswin   = prodat(nword13+14) - staswi(ns)
        prswout  = prodat(nword13+15) - staswo(ns)
        prlwin   = prodat(nword13+16) - stalwi(ns)
        prlwout  = prodat(nword13+17) - stalwo(ns)
        prlwtoa  = prodat(nword13+18) - stalwt(ns)
        prswtoa  = prodat(nword13+19) - staswt(ns)
        pacsnow  = prodat(nword13+20) - stasno(ns)
        pacsnom  = prodat(nword13+23) - stasnm(ns)
        IF (kclass(ns) /= 2) THEN
           !    MAY HAVE ALREADY  BEEN DONE IN CLASS 0
           pssroff  = prodat(nword13+24) - stasrf(ns)
           pbgroff  = prodat(nword13+25) - stabrf(ns)
        END IF

        staevp(ns) = prodat(nword13+9 )
        stapot(ns) = prodat(nword13+10)
        stashx(ns) = prodat(nword13+11)
        stasub(ns) = prodat(nword13+12)
        stapcx(ns) = prodat(nword13+13)
        staswi(ns) = prodat(nword13+14)
        staswo(ns) = prodat(nword13+15)
        stalwi(ns) = prodat(nword13+16)
        stalwo(ns) = prodat(nword13+17)
        stalwt(ns) = prodat(nword13+18)
        staswt(ns) = prodat(nword13+19)
        stasno(ns) = prodat(nword13+20)
        stasnm(ns) = prodat(nword13+23)
        IF (kclass(ns) /= 2) THEN
           !    MAY HAVE ALREADY  BEEN DONE IN CLASS 0
           stasrf(ns) = prodat(nword13+24)
           stabrf(ns) = prodat(nword13+25)
        END IF

        !              ZERO ACCUMULATED QUATITIES IF IS IT TIME TO DO SO.

        IF(MOD(ntsd,nprec) < nphs)THEN
           stasnm(ns) = d00
           stasno(ns) = d00
           stasrf(ns) = d00
           stabrf(ns) = d00
        END IF
        IF(MOD(ntsd,nrdsw) < nphs)THEN
           staswi(ns) = d00
           staswo(ns) = d00
           staswt(ns) = d00
        END IF
        IF(MOD(ntsd,nrdlw) < nphs)THEN
           stalwi(ns) = d00
           stalwo(ns) = d00
           stalwt(ns) = d00
        END IF
        IF(MOD(ntsd,nsrfc) < nphs)THEN
           staevp(ns) = d00
           stapot(ns) = d00
           stashx(ns) = d00
           stasub(ns) = d00
           stapcx(ns) = d00
        END IF

        !          TRANSFER STATION PROFILE DATA TO "PACKED" OUTPUT ARRAY.
        nn   = 0
        nlen = fpack(7)
!chou
!chou  excluding tcucn, train, swttc and rlwtt from the fpack vector
!chou  equivalent to exclude PRODAT(NWORD:8,9,10,11) from the fpack vector
!chou  transfer up to the 7th variable => NWORD7

       IF (EXCTDN) THEN
          NLEN1= 9+ NWORD7
          DO N = 10,NLEN1
            NN = N-9
            FPACK(N) = PRODAT(NN)
          ENDDO
          N1=NLEN1 +1
          NM=4*LMHK         ! 4 fields (3-d) were excluded
          DO N = N1, NLEN-NM
            NN = NWORD11+1 + (N-N1)
            FPACK(N) = PRODAT(NN)
          ENDDO

          NWORD13=NWORD9

          FPACK(9+NWORD13+7)  = STAPRX
          FPACK(9+NWORD13+8)  = STACRX
          FPACK(9+NWORD13+9)  = PSFCEVP * RTSPH
          FPACK(9+NWORD13+10) = PPOTEVP * RTSPH
          FPACK(9+NWORD13+11) = PSFCSHX * RTSPH
          FPACK(9+NWORD13+12) = PSFCSUB * RTSPH
          FPACK(9+NWORD13+13) = PSNOPCX * RTSPH
          FPACK(9+NWORD13+14) = PRSWIN  * RTSPH
          FPACK(9+NWORD13+15) = PRSWOUT * RTSPH
          FPACK(9+NWORD13+16) = PRLWIN  * RTSPH
          FPACK(9+NWORD13+17) = PRLWOUT * RTSPH
          FPACK(9+NWORD13+18) = PRLWTOA * RTSPH
          FPACK(9+NWORD13+19) = PRSWTOA * RTSPH
          FPACK(9+NWORD13+20) = PACSNOW
          FPACK(9+NWORD13+23) = PACSNOM
          FPACK(9+NWORD13+24) = PSSROFF
          FPACK(9+NWORD13+25) = PBGROFF

!   
!           WRITE DATA FOR CLASS 1 OR 2 SITE.
!
          FPCTMP=FPACK(7)
          FPACK(7)=9 + LMHK* (LCL1ML-4) + LCL1SL
          WRITE(LCLAS1) IHRST,IDAT,IFCST,ISTAT,(FPACK(N),N=1,NLEN-NM)
          FPACK(7)= FPCTMP
       ELSE
!Chou

        DO n = 10,nlen
           nn = n-9
           fpack(n) = prodat(nn)
        END DO

        !           REPLACE ACCUMULATED QUANTITIES WITH ACCUMULATION
        !           SINCE LAST PROFILE OUTPUT TIME.

        DO ll = 1,lmhk
           fpack(9+nword7+ll)  = stadhc(ll)*rtscu
           fpack(9+nword8+ll)  = stadhr(ll)*rtsra
        END DO
        fpack(9+nword13+7)  = staprx
        fpack(9+nword13+8)  = stacrx
        fpack(9+nword13+9)  = psfcevp * rtsph
        fpack(9+nword13+10) = ppotevp * rtsph
        fpack(9+nword13+11) = psfcshx * rtsph
        fpack(9+nword13+12) = psfcsub * rtsph
        fpack(9+nword13+13) = psnopcx * rtsph
        fpack(9+nword13+14) = prswin  * rtsph
        fpack(9+nword13+15) = prswout * rtsph
        fpack(9+nword13+16) = prlwin  * rtsph
        fpack(9+nword13+17) = prlwout * rtsph
        fpack(9+nword13+18) = prlwtoa * rtsph
        fpack(9+nword13+19) = prswtoa * rtsph
        fpack(9+nword13+20) = pacsnow
        fpack(9+nword13+23) = pacsnom
        fpack(9+nword13+24) = pssroff
        fpack(9+nword13+25) = pbgroff

        !           WRITE DATA FOR CLASS 1 OR 2 SITE.

        WRITE(lclas1) ihrst,idat,ifcst,istat,(fpack(n),n=1,nlen)

       ENDIF     !Chou  endif of block  whether outputing profile tendencies

        !        END OF IF THEN BLOCK FOR CLASS 1 OR 2 SITE.
     END IF

     !           RESET MAX AND MIN LOWEST LAYER TEMP HOLD ARRAYS

     tlmin(ns) = 999.0
     tlmax(ns) = -999.0

     !     END OF PROFILE SITE LOOP
  END DO

  !     END PROFILE POSTING CODE.


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


  DO  l=1,lm
     sumt=0.
     DO j=1,jm,2
        DO i=1,im
           sumt=sumt+t(i,j,l)
        END DO
     END DO

     DO j=2,jm-1,2
        DO i=1,im-1
           sumt=sumt+t(i,j,l)
        END DO
     END DO

     sumt=sumt/REAL(imjm)
     WRITE(6,1095)l,sumt
1095 FORMAT(' L=',i2,' TAVG=',e13.6)
  END DO

  !     WE REACH THE CODE BELOW ONLY IF IT IS A FULL BLOWN POSTING TIME.
  !     WRITE DATA REQUIRED TO RESTART THE MODEL/INITIALIZE THE POST.

  !     TTND IS THE CURRENT RAD TEMP TENDENCIES.

  DO l = 1,lm
     DO j=1,jm
        DO i=1,im
           ttnd(i,j,l)=rlwtt(i,j,l)+swttc(i,j,l)
        END DO
     END DO
  END DO
  label = 'BND,PD,RES,T,Q,U,V,Q2,TTND,CWM,TRAIN,TCUCN'
  WRITE(lrstrt) run,idat,ihrst,ntsd,label, first,iout,nshde
  WRITE(lrstrt) pd,((res(i,j),i=1,im),j=1,jm) ,             fis
  WRITE(lrstrt) pdb,tb,qb,ub,vb
  !hou
!  WRITE(88,*) pd,res(200,200), fis
!chou  WRITE(88,*) pdb,tb,qb,ub,vb
  DO l = 1,lm
     WRITE(lrstrt)((t(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((q(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((u(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((v(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((q2(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((ttnd(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((cwm(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((train(i,j,l),i=1,im),j=1,jm)
     WRITE(lrstrt)((tcucn(i,j,l),i=1,im),j=1,jm)
  END DO
  !hou
  PRINT*,' in CHKOUT, ntsd=',ntsd
  iii=50
  jjj=100
!chou  WRITE(88,'(1x," T=",/,8(5G12.3))')(t(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," Q=",/,8(5G12.3))')(q(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," U=",/,8(5G12.3))')(u(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," Q2=",/,8(5G12.3))')(q2(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," TTND=",/,8(5G12.3))')(ttnd(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," CWM=",/,8(5G12.3))')(cwm(iii,jjj,l),l=1,lm)
!chou  WRITE(88,'(1x," TRAIN=",/,8(5G12.3))')(train(iii,jjj,l),l=1,lm)

  label = 'MISC VARIABLES'
  WRITE(lrstrt) run,idat,ihrst,ntsd,label ,             rswin,rswout,tg,z0  &
       ,             ((akms(i,j),i=1,im),j=1,jm) ,             czen
  WRITE(lrstrt) akhs,ths,qs,twbs,qwbs,hbot,cfracl
  WRITE(lrstrt) thz0,qz0 ,             ((uz0(i,j),i=1,im),j=1,jm)  &
       ,             ((vz0(i,j),i=1,im),j=1,jm) ,             ustar,htop,cfracm
  WRITE(lrstrt) sno,wet,cldefi,rf,((pslp(i,j),i=1,im),j=1,jm)  &
       ,             cuppt,cfrach
  WRITE(lrstrt) soiltb,sfcexc,smstav,smstot,grnflx,pctsno
  WRITE(lrstrt) rlwin,radot,czmean,sigt4
  WRITE(lrstrt) u00,ul,lc,sr

  label = 'ACCUMULATED VARIABLES'
  WRITE(lrstrt) run,idat,ihrst,ntsd,label, prec,acprec,accliq,cuprec
  WRITE(lrstrt) acfrcv,ncfrcv,acfrst,ncfrst
  WRITE(lrstrt) acsnow,acsnom,ssroff,bgroff
  WRITE(lrstrt) sfcshx,sfclhx,subshx,snopcx, sfcuvx,sfcevp,potevp
  WRITE(lrstrt) aswin,aswout,aswtoa,alwin,alwout,alwtoa
  WRITE(lrstrt) ardsw,ardlw,asrfc,avrain,avcnvc
  WRITE(lrstrt) th10,q10,u10,v10,tshltr,qshltr,pshltr
  WRITE(lrstrt) smc
  WRITE(lrstrt) cmc
  WRITE(lrstrt) stc

  !     CLOSE THE RESTART FILE.
  CLOSE(lrstrt)


  !     EDIT POST JOB SCRIPT TO ACCESS DATA JUST WRITTEN.

  CALL getenv("tmmark",astmrk)
  IF(astmrk == '    ') THEN
     WRITE(ASSIGN,1200) itag
1200 FORMAT('.assign',i2.2)
  ELSE
     WRITE(ASSIGN,1230) itag, astmrk
1230 FORMAT('.assign',i2.2,a4)
  END IF
  WRITE(outjob,1240) itag
1240 FORMAT('outjob',i2.2)
  WRITE(list,*)'CHKOUT:  GENERATE POST SCRIPT FILE ',outjob

  lunin = 21
  lunot = 5
  REWIND(lunin)
  OPEN(lunot,FILE=outjob)
1250 READ(lunin,1260,END=1290) line
1260 FORMAT(a80)
  !     TMMARK STATEMENT.
  IF(INDEX(line,'tmmark=') /= 0)THEN
     IF(line1(11) == '0')THEN
        CALL getenv("TM00",TMYY)          ! chou capitalize
     ELSE IF(line1(11) == '3')THEN
        CALL getenv("TM03",TMYY)          ! chou capitalize
     ELSE IF(line1(11) == '6')THEN
        CALL getenv("TM06",TMYY)          ! chou capitalize
     ELSE IF(line1(11) == '9')THEN
        CALL getenv("TM09",TMYY)          ! chou capitalize
     ELSE IF(line1(11) == '2')THEN
        CALL getenv("TM12",TMYY)          ! chou capitalize
     END IF
     WRITE(lunot,1260) line
     GO TO 1250
  END IF

  !     TMYY STATEMENT
  IF(INDEX(line,'TMYY=') /= 0)THEN
     line = 'TMYY='//TMYY
     WRITE(lunot,1260) line
     GO TO 1250
  END IF


  !     ASSIGN STATEMENT.
  IF(INDEX(line,'ASSIGN=') /= 0)THEN
     line = 'ASSIGN='//ASSIGN
     WRITE(lunot,1260) line
     GO TO 1250
  END IF

  !     MODEL RESTART FILE.
  IF(INDEX(line,'RESTRT=') /= 0)THEN
     line = 'RESTRT='//rstfil
     WRITE(lunot,1260) line
     PRINT*,' line:', line      !chou checking name of restart file

     GO TO 1250
  END IF

  !     LINES CONTAINING qq NEED TO BE MODIFIED FOR DISPOSE
  !     FROM AND TO PROPER PLACES
  IF(INDEX(line,'qq') /= 0)THEN
     ihr1 = ihr / 10
     ihr2 = ihr - 10 * ihr1
     iputit = INDEX(line,'qq')
     WRITE(line1(iputit),1270)ihr1
     WRITE(line1(iputit+1),1270)ihr2
1270 FORMAT(i1)
     istrt = iputit + 2
     DO i = istrt,80
        IF(line1(i) == 'q')THEN
           WRITE(line1(i),1270)ihr1
           WRITE(line1(i+1),1270)ihr2
           GO TO 1280
        END IF
     END DO
1280 CONTINUE
     WRITE(lunot,1260)line
     GO TO 1250
  END IF

  !     TURN ON LINE TO QUEUE JOB AFTER ALL OUTPUT JOBS.
  IF(ntsd >= ntstm)THEN
     IF(INDEX(line,'$LAST') /= 0)THEN
        lxx  = INDEX(line,'#')
        line = line(lxx+1:80)
        WRITE(lunot,1260) line
        GO TO 1250
     END IF
  END IF

  !     IF NOTHING TRIGGERED ABOVE, WRITE LINE TO OUTPUT FILE.
  WRITE(lunot,1260) line
  GO TO 1250

1290 CONTINUE
  CLOSE(lunot)

  !     IF SUBPOST (NAMELIST INPUT VARIABLE) IS TRUE THEN
  !     THE FOLLOWING CALL TO ISHELL WILL SUBMIT A POST JOB TO
  !     PROCESS THE DATA JUST WRITTEN TO THE TEMPORARY FILES.

  !     IF SUBPOST IS FALSE ISHELL WILL NOT BE CALLED AND
  !     THE POST JOB SHOULD BE SUBMITTED LATER IN THE SCRIPT

  IF(subpost)THEN
     submit = submit(1:25) // outjob
     WRITE(list,*)'CHKOUT:  SUBMIT POST JOB ',submit
     !ray        CALL ISHELL(SUBMIT)
     CALL system(submit)    ! NEC equivalent
  END IF

  !***
  !     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)THEN
     iout = iout+1
     IF (.NOT.restrt)   GO TO 1300
     IF (ntsd == nshde) GO TO 1300
     iout  = iout-1
1300 nshde = ishde(iout)
  END IF

  !     ZERO ACCUMULATOR ARRAYS.
  !     AVERAGE CLOUD AMOUNT ARRAY
1310 CONTINUE
  IF(MOD(ntsd,nclod) < nphs)THEN
     WRITE(list,*)'CHKOUT:  ZERO AVG CLD AMT ARRAY'
     DO j=1,jm
        DO i=1,im
           acfrcv(i,j) = d00
           ncfrcv(i,j) = 0
           acfrst(i,j) = d00
           ncfrst(i,j) = 0
        END DO
     END DO
  END IF

  !     TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
  !     TOTAL SNOW AND SNOW MELT ARRAYS.
  !     STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
  !     PRECIPITATION TYPE ARRAY
  IF(MOD(ntsd,nprec) < ncnvc)THEN
     WRITE(list,*)'CHKOUT:  ZERO ACCUM PRECIP ARRAYS'
     DO j=1,jm
        DO i=1,im
           acprec(i,j) = d00
           cuprec(i,j) = d00
           acsnow(i,j) = d00
           acsnom(i,j) = d00
           ssroff(i,j) = d00
           bgroff(i,j) = d00
           sfcevp(i,j) = d00
           potevp(i,j) = d00
        END DO
     END DO
  END IF

  !     GRID-SCALE AND CONVECTIVE (LATENT) HEATING ARRAYS.
  IF(MOD(ntsd,nheat) < ncnvc)THEN
     WRITE(list,*)'CHKOUT:  ZERO ACCUM LATENT HEATING ARRAYS'
     avrain = d00
     avcnvc = d00
     DO l = 1,lm
        DO j=1,jm
           DO i=1,im
              train(i,j,l) = d00
              tcucn(i,j,l) = d00
           END DO
        END DO
     END DO
  END IF

  !     LONG WAVE RADIATION ARRAYS.
  IF(MOD(ntsd,nrdlw) < nphs)THEN
     WRITE(list,*)'CHKOUT:  ZERO ACCUM LW RADTN ARRAYS'
     ardlw = d00
     DO j=1,jm
        DO i=1,im
           alwin(i,j) = d00
           alwout(i,j) = d00
           alwtoa(i,j) = d00
        END DO
     END DO
  END IF

  !     SHORT WAVE RADIATION ARRAYS.
  IF(MOD(ntsd,nrdsw) < nphs)THEN
     WRITE(list,*)'CHKOUT:  ZERO ACCUM SW RADTN ARRAYS'
     ardsw = d00
     DO j=1,jm
        DO i=1,im
           aswin(i,j) = d00
           aswout(i,j) = d00
           aswtoa(i,j) = d00
        END DO
     END DO
  END IF

  !     SURFACE SENSIBLE AND LATENT HEAT FLUX ARRAYS.
  IF(MOD(ntsd,nsrfc) < nphs)THEN
     WRITE(list,*)'CHKOUT:  ZERO ACCUM SFC FLUX ARRAYS'
     asrfc = d00
     DO j=1,jm
        DO i=1,im
           sfcshx(i,j) = d00
           sfclhx(i,j) = d00
           subshx(i,j) = d00
           snopcx(i,j) = d00
           sfcuvx(i,j) = d00
           potflx(i,j) = d00
        END DO
     END DO
  END IF

  !     END OF ROUTINE.

  RETURN
END SUBROUTINE chkout
