SUBROUTINE QUILT C C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBROUTINE: QUILT I/O SERVERS C PRGRMMR: TUCCILLO ORG: IBM DATE: 00-01-20 C C ABSTRACT: I/O SERVERS C C PROGRAM HISTORY LOG: C 00-01-20 TUCCILLO - ORIGINATOR C 00-11-02 BLACK - SLP FOR NEST BOUNDARIES C 00-12-12 BLACK - RESTART CAPABILITY C C USAGE: CALL QUILT C C INPUT ARGUMENT LIST: C NONE C C OUTPUT ARGUMENT LIST: C NONE C C INPUT FILES: NONE C C OUTPUT FILES: NONE C C SUBPROGRAMS CALLED: C UNIQUE: C MPI_RECV C MPI_BCAST C COLLECT C SLP C DECOAL C C EXIT STATES: C COND = 0 - NORMAL EXIT C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE : IBM SP C C$$$ C C THIS CODE ASSUMES THAT NSOIL IS GE TO 4. IF THIS IS NOT TRUE, C THE CODE WILL STOP. THE EQUIVALENCING IS THE PROBLEM. C C----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "parmsoil" INCLUDE "mpif.h" INCLUDE "mpp.h" C----------------------------------------------------------------------- INCLUDE "PARA.comm" INCLUDE "BUFFER.comm" C----------------------------------------------------------------------- P A R A M E T E R & (LB=2*IM+JM-3) C----------------------------------------------------------------------- C REAL DUM1(IM,JM),DUM2(IM,JM),DUM3(IM,JM),DUM4(IM,JM) REAL DUM5(IM,JM),DUM6(IM,JM),DUM7(IM,JM) CGSM v100m REAL DUM8(IM,JM),DUM9(IM,JM),DUM10(IM,JM),DUM11(IM,JM) CGSM 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) ) C C----------------------------------------------------------------------- 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(:,:) CGSM v100m &,TH100(:,:),Q100(:,:),U100(:,:),V100(:,:) CGSM v100m &,TH10(:,:),Q10(:,:),U10(:,:),V10(:,:),TSHLTR(:,:) &,QSHLTR(:,:),PSHLTR(:,:),CMC(:,:),POTFLX(:,:) &,TLMIN(:,:),TLMAX(:,:),RSWTOA(:,:),RLWTOA(:,:) &,CNVBOT(:,:),CNVTOP(:,:),ALBEDO(:,:) Cmp &,SM(:,:),HBM2(:,:),DETA(:) Cmp C REAL UL(2*LM) C REAL, ALLOCATABLE :: & OMGALF(:,:,:),T(:,:,:),Q(:,:,:),U(:,:,:) &,V(:,:,:),Q2(:,:,:),TTND(:,:,:),CWM(:,:,:) &,TRAIN(:,:,:),TCUCN(:,:,:) &,RSWTT(:,:,:),RLWTT(:,:,:) C REAL, ALLOCATABLE :: & SMC(:,:,:),STC(:,:,:),SH2O(:,:,:) R E A L & 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) C C----------------------------------------------------------------------- INTEGER IDAT(3) C INTEGER, ALLOCATABLE :: & LC(:,:),NCFRCV(:,:),NCFRST(:,:) C----------------------------------------------------------------------- L O G I C A L & RUN,FIRST,HYDRO,SIGMA Cmp & RUN,FIRST C----------------------------------------------------------------------- C H A R A C T E R & 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 C----------------------------------------------------------------------- DATA LRSTRT1/21/,LRSTRT2/61/,NHB/12/,BLANK/' '/ C----------------------------------------------------------------------- C real*8 timef, ist, isp, rtc, ist2, isp2, icum C----------------------------------------------------------------------- REAL,DIMENSION(999999) :: TSHDE REAL,DIMENSION(LSM) :: SPL LOGICAL :: RESTRT,SINGLRST,SUBPOST,NEST,SPLINE C C DECLARE NAMELIST C 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 C NAMELIST /POSTLIST/chmo NAMELIST /POSTLIST/submit !chou C----------------------------------------------------------------------- CALL MPI_FIRST C*** C*** READ NAMELIST FCSTDATA TO FIND OUT IF THIS IS A NESTED RUN C*** READ(11,FCSTDATA) C IF(NSOIL.LT.4)THEN PRINT*, ' NSOIL IS LESS THAN 4. CHANGE THE EQUIVALENCES' PRINT*, ' STOPPING' CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR) ENDIF C IF(ME.EQ.0)THEN LME=.TRUE. ELSE LME=.FALSE. ENDIF Cmp C READ NHB FILE TO OBTAIN SIGMA 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 Cmp C C 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)) CGSM 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)) CGSM 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)) Cmp ALLOCATE(HBM2(IM,MY_JSD:MY_JED)) ALLOCATE(SM(IM,MY_JSD:MY_JED)) ALLOCATE(DETA(1:LM)) Cmp C C----------------------------------------------------------------------- C----------------------------------------------------------------------- C*** C*** LOOP OVER ALL THE OUTPUT TIMES C*** C----------------------------------------------------------------------- 666 CONTINUE C IF(ME.EQ.0)THEN CALL MPI_RECV(IHOUR,1,MPI_INTEGER,0,0,MPI_COMM_INTER,STATUS,IER) PRINT*,' ihour in quilt = ',IHOUR ENDIF C CALL MPI_BCAST(IHOUR,1,MPI_INTEGER,0,MPI_COMM_COMP,IER) C IF(IHOUR.EQ.-999)GO TO 667 C IST=RTC() C ICUM=0. C----------------------------------------------------------------------- DO 200 IXXX=1,JEND(ME)-JSTA(ME)+1 C----------------------------------------------------------------------- C*** C*** RECEIVE ALL THE DATA FROM CHKOUT FROM C*** THE APPROPRIATE FORECAST TASKS C*** ist=timef() CALL MPI_RECV(BUF,IBUFMAX,MPI_REAL,MPI_ANY_SOURCE,IHOUR, 1 MPI_COMM_INTER,STATUS,IER) IPE=STATUS(MPI_SOURCE) C IF(IER.NE.0)THEN PRINT*,' error from mpi_rec = ',IER ENDIF C C ist2 = rtc() C 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) C C EXTRACT RECORD LENGTH - LETS KEEP THIS BECAUSE IT IS POTENTIALLY HANDY CALL DECOAL(IDUM,-1) C 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) C DO L=1,LM CALL DECOAL(OMGALF(IS:IE,JS:JE,L),LEN_CH) ENDDO C 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) C 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 C 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) CGSM 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) CGSM 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) C 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 C 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) C icum = icum + rtc() -ist2 Cmp 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 Cmp 200 CONTINUE C C isp=rtc() C PRINT*,' TIME FOR RECV/ASSEMBLY = ',isp-ist C PRINT*,' TIME FOR DECOAL = ',icum C----------------------------------------------------------------------- C*** C*** BEFORE WRITING OUT THE RESTRT FILE, COMPUTE THE MSLP C*** C C ist=rtc() Cmp 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 1, DETA,PT,PSLP) else print*,'calling slpsig' CALL SLPSIG(PD,FIS,SM,T,Q,CWM,HBM2,U00,SPL,LSM 1, UL,DETA,PT,PSLP) end if ELSE print*,'calling slp' CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP) END IF C isp=rtc() C PRINT*,' time for SLP = ',isp-ist C C----------------------------------------------------------------------- C*** WRITE OUT THE GLOBAL RESTRT FILE. C----------------------------------------------------------------------- C*** C*** GENERATE THE NAME OF THE GLOBAL OUTPUT RESTRT FILE C*** ENVAR=' ' CALL GETENV("RSTFNL",ENVAR) CALL GETENV("tmmark",RESTHR) RESTHR='t00s' KPATH = INDEX(ENVAR,' ') -1 IF(KPATH.LE.0) KPATH = LEN(ENVAR) C IF(RESTHR.EQ.' ')THEN WRITE(RSTFIL2,280)IHOUR 280 FORMAT('restrt',I6.6) ELSE WRITE(RSTFIL2,285)IHOUR,RESTHR 285 FORMAT('restrt',I6.6,'.',a4) ENDIF C KRST=INDEX(RSTFIL2,' ') -1 IF(KRST.LE.0)KRST=LEN(RSTFIL2) C*** C*** OPEN UNIT TO THE GLOBAL RESTART FILE C*** CLOSE(LRSTRT2) C C ist = rtc() IF(ENVAR(1:4).EQ.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 C----------------------------------------------------------------------- IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour CALL COLLECT(PDOMG,DUM1) CALL COLLECT(RESOMG,DUM2) IF(LME)WRITE(LRSTRT2)DUM1,DUM2 C DO L=1,LM CALL COLLECT(OMGALF(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 ENDDO C IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour, 1 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 C DO L=1,LM CALL COLLECT(T(:,:,L),DUM1) c 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 C 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 1, DUM1,DUM2,DUM3,DUM4,DUM5,DUM6 C 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 C 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 C 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 C 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 C CALL COLLECT(RLWIN,DUM1) CALL COLLECT(RADOT,DUM2) CALL COLLECT(CZMEAN,DUM3) CALL COLLECT(SIGT4,DUM4) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4 C CALL COLLECT(U00,DUM1) CALL COLLECT(LC,DUM2) CALL COLLECT(SR,DUM3) IF(LME)WRITE(LRSTRT2)DUM1,UL,DUM2,DUM3 C 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 1, DUM1,DUM2,DUM3,DUM4 C CALL COLLECT(ACFRCV,DUM1) CALL COLLECT(NCFRCV,DUM2) CALL COLLECT(ACFRST,DUM3) CALL COLLECT(NCFRST,DUM4) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4 C CALL COLLECT(ACSNOW,DUM1) CALL COLLECT(ACSNOM,DUM2) CALL COLLECT(SSROFF,DUM3) CALL COLLECT(BGROFF,DUM4) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4 C 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 C 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 C IF(LME)WRITE(LRSTRT2)ARDSW,ARDLW,ASRFC,AVRAIN,AVCNVC C 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) CGSM V100m CALL COLLECT(TH100,DUM8) CALL COLLECT(Q100,DUM9) CALL COLLECT(U100,DUM10) CALL COLLECT(V100,DUM11) CGSM V100m IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 CGSM V100m 1, DUM8,DUM9,DUM10,DUM11 CGSM V100m C DO L=1,NSOIL CALL COLLECT(SMC(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS C CALL COLLECT(CMC,DUM1) IF(LME)WRITE(LRSTRT2) DUM1 C DO L=1,NSOIL CALL COLLECT(STC(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS C DO L=1,NSOIL CALL COLLECT(SH2O(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS C CALL COLLECT(ALBEDO,DUM1) IF(LME)WRITE(LRSTRT2) DUM1 C CALL COLLECT(POTFLX,DUM1) CALL COLLECT(TLMIN,DUM2) CALL COLLECT(TLMAX,DUM3) IF(LME)WRITE(LRSTRT2) DUM1, DUM2, DUM3 1, ACUTIM,ARATIM,APHTIM 2, NHEAT,NPHS,NCNVC,NPREC,NRDSW,NRDLW,NSRFC 3, TPH0D,TLM0D,RESTRT C 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 C 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 C CLOSE(LRSTRT2) C C isp=rtc() C IF(LME)THEN ! PRINT*,' time for I/O = ',isp-ist ENDIF C----------------------------------------------------------------------- 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) CJLG REWIND(11) READ(11,POSTLIST) ! chou WRITE(LIST,POSTLIST) ! chou WRITE(outjob,1240)ITAG 1240 FORMAT('outjob_special',I6.6,'.ksh') lunin = 67 lunot = 68 OPEN(lunin,FILE='outjob_special.ksh') OPEN(lunot,FILE=outjob) 1260 FORMAT(a85) REWIND(lunin) DO i=1,11 READ(lunin,1260) line idx=index(line,' ')-1 WRITE(lunot,1260) line ENDDO 1261 FORMAT('Hfct=',I6.6) WRITE(lunot,1261) ITAG 1250 READ(lunin,1260,END=1290) line WRITE(lunot,1260) line GO TO 1250 1290 CONTINUE close(lunot) close(lunin) idx=index(submit,'#')-1 submit = submit(1:idx) // outjob chx=index(chmo,'#')-1 chmo = chmo(1:chx) // outjob CALL system(chmo) WRITE(list,*)'CHKOUT: SUBMIT POST JOB ',submit CALL system(submit) ! NEC equivalent CJLG IF(IER.NE.0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL: DONE' ENDIF C GO TO 666 667 CONTINUE C PRINT*,' QUILT I/O SERVER SHUTTING DOWN NOW' END C----------------------------------------------------------------------- C----------------------------------------------------------------------- SUBROUTINE DECOAL(A,LEN_CH) INCLUDE "BUFFER.comm" REAL A(*) C IF(LEN_CH.LT.0)THEN IP=0 ENDIF C DO I=1,ABS(LEN_CH) IP=IP+1 A(I)=BUF(IP) ENDDO C END