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-12-06 BLACK - SLP FOR NEST BOUNDARIES 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) REAL DUM8(IM,JM),DUM9(IM,JM),DUM10(IM,JM),DUM11(IM,JM) REAL DUM12(IM,JM),DUM13(IM,JM),DUM14(IM,JM),DUM15(IM,JM) REAL DUM16(IM,JM) 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(:,:),CNVBOT(:,:),CFRACL(:,:),THZ0(:,:),QZ0(:,:) &,UZ0(:,:),VZ0(:,:),USTAR(:,:),CNVTOP(:,:),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(:,:) &,TH30(:,:),Q30(:,:),U30(:,:),V30(:,:) &,TH10(:,:),Q10(:,:),U10(:,:),V10(:,:),TSHLTR(:,:) &,QSHLTR(:,:),PSHLTR(:,:),CMC(:,:),POTFLX(:,:) &,TLMIN(:,:),TLMAX(:,:),RSWTOA(:,:),RLWTOA(:,:) &,P0(:,:),HBOT(:,:),HTOP(:,:),ALBEDO(:,:) &,FQU(:,:),FQV(:,:),DQFLX(:,:) &,FCU(:,:),FCV(:,:),DCFLX(:,:) &,FQU7(:,:),FQV7(:,:),DQFLX7(:,:) &,FCU7(:,:),FCV7(:,:),DCFLX7(:,:) &,DQADV(:,:),FQNEV1(:,:),FQSEV1(:,:) &,VAPINC(:,:),CLDINC(:,:),VAPINC7(:,:),CLDINC7(:,:) C REAL UL(2*LM) C REAL, ALLOCATABLE :: & OMGALF(:,:,:),T(:,:,:),Q(:,:,:),U(:,:,:) &,V(:,:,:),Q2(:,:,:),TTND(:,:,:),CWM(:,:,:) &,TRAIN(:,:,:),TCUCN(:,:,:) &,RSWTT(:,:,:),RLWTT(:,:,:) &,T0(:,:,:),Q0(:,:,:) 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 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 C 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(99) :: TSHDE REAL,DIMENSION(LSM) :: SPL LOGICAL :: RESTRT,SINGLRST,SUBPOST,NEST 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 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 C btim=timef() 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(CFRACM(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(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)) ALLOCATE(TH30(IM,MY_JSD:MY_JED)) ALLOCATE(Q30(IM,MY_JSD:MY_JED)) ALLOCATE(U30(IM,MY_JSD:MY_JED)) ALLOCATE(V30(IM,MY_JSD:MY_JED)) 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(FQU(IM,MY_JSD:MY_JED)) ALLOCATE(FQV(IM,MY_JSD:MY_JED)) ALLOCATE(DQFLX(IM,MY_JSD:MY_JED)) ALLOCATE(FCU(IM,MY_JSD:MY_JED)) ALLOCATE(FCV(IM,MY_JSD:MY_JED)) ALLOCATE(DCFLX(IM,MY_JSD:MY_JED)) ALLOCATE(FQU7(IM,MY_JSD:MY_JED)) ALLOCATE(FQV7(IM,MY_JSD:MY_JED)) ALLOCATE(DQFLX7(IM,MY_JSD:MY_JED)) ALLOCATE(FCU7(IM,MY_JSD:MY_JED)) ALLOCATE(FCV7(IM,MY_JSD:MY_JED)) ALLOCATE(DCFLX7(IM,MY_JSD:MY_JED)) ALLOCATE(DQADV(IM,MY_JSD:MY_JED)) ALLOCATE(FQNEV1(IM,MY_JSD:MY_JED)) ALLOCATE(FQSEV1(IM,MY_JSD:MY_JED)) ALLOCATE(VAPINC(IM,MY_JSD:MY_JED)) ALLOCATE(CLDINC(IM,MY_JSD:MY_JED)) ALLOCATE(VAPINC7(IM,MY_JSD:MY_JED)) ALLOCATE(CLDINC7(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(T0(MY_ISD:MY_IED,MY_JSD:MY_JED,1:LM)) ALLOCATE(Q0(MY_ISD:MY_IED,MY_JSD:MY_JED,1:LM)) ALLOCATE(P0(MY_ISD:MY_IED,MY_JSD:MY_JED)) 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)) C C----------------------------------------------------------------------- C----------------------------------------------------------------------- C*** C*** LOOP OVER ALL THE OUTPUT TIMES C*** C----------------------------------------------------------------------- 666 CONTINUE 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 IST=RTC() ICUM=0. C----------------------------------------------------------------------- C*** C*** JSTA IS THE FIRST FORECAST TASK AND JEND IS THE LAST C*** FORECAST TASK IN THE ENTIRE RANGE OF FORECAST TASKS C*** THAT WILL BE SENDING TO EACH QUILT TASK (ME). REMEMBER C*** THAT AN INTEGER NUMBER OF FORECAST TASK ROWS IS C*** SENT TO EACH QUILT TASK. C*** 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*** 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 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) C C EXTRACT RECORD LENGTH - LETS KEEP THIS IN BECAUSE IT IS POTENTIALLY HANDY LEN_CH=(IE-IS+1)*(JE-JS+1) C 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) CALL DECOAL(TH30(IS:IE,JS:JE),LEN_CH) CALL DECOAL(Q30(IS:IE,JS:JE),LEN_CH) CALL DECOAL(U30(IS:IE,JS:JE),LEN_CH) CALL DECOAL(V30(IS:IE,JS:JE),LEN_CH) 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(FQU(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FQV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(DQFLX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FCU(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FCV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(DCFLX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FQU7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FQV7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(DQFLX7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FCU7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FCV7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(DCFLX7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(DQADV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FQNEV1(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FQSEV1(IS:IE,JS:JE),LEN_CH) CALL DECOAL(VAPINC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CLDINC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(VAPINC7(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CLDINC7(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 DO L=1,LM CALL DECOAL(T0(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(Q0(IS:IE,JS:JE,L),LEN_CH) ENDDO C CALL DECOAL(P0(IS:IE,JS:JE),LEN_CH) 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 200 CONTINUE C isp=rtc() PRINT*,' TIME FOR RECV/ASSEMBLY = ',isp-ist PRINT*,' TIME FOR DECOAL = ',icum C----------------------------------------------------------------------- C*** C*** BEFORE WRITING OUT THE RESTRT FILE, COMPUTE THE MSLP C*** C ist=rtc() CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP) 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 get_environment_variable("RSTFNL",ENVAR) CALL get_environment_variable("tmmark",RESTHR) KPATH = INDEX(ENVAR,' ') -1 IF(KPATH.LE.0) KPATH = LEN(ENVAR) C IF(RESTHR.EQ.' ')THEN WRITE(RSTFIL2,280)IHOUR 280 FORMAT('restrt',I2.2) ELSE WRITE(RSTFIL2,285)IHOUR,RESTHR 285 FORMAT('restrt',I2.2,'.',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 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 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, 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 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 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) CALL COLLECT(TH30,DUM8) CALL COLLECT(Q30,DUM9) CALL COLLECT(U30,DUM10) CALL COLLECT(V30,DUM11) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 1, DUM8,DUM9,DUM10,DUM11 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(FQU,DUM1) CALL COLLECT(FQV,DUM2) CALL COLLECT(DQFLX,DUM3) CALL COLLECT(FCU,DUM4) CALL COLLECT(FCV,DUM5) CALL COLLECT(DCFLX,DUM6) CALL COLLECT(FQU7,DUM7) CALL COLLECT(FQV7,DUM8) CALL COLLECT(DQFLX7,DUM9) CALL COLLECT(FCU7,DUM10) CALL COLLECT(FCV7,DUM11) CALL COLLECT(DCFLX7,DUM12) CALL COLLECT(DQADV,DUM13) CALL COLLECT(FQNEV1,DUM14) CALL COLLECT(FQSEV1,DUM15) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 1, DUM8,DUM9,DUM10,DUM11,DUM12,DUM13 2, DUM14,DUM15 C CALL COLLECT(VAPINC,DUM1) CALL COLLECT(CLDINC,DUM2) CALL COLLECT(VAPINC7,DUM3) CALL COLLECT(CLDINC7,DUM4) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4 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 DO L=1,LM CALL COLLECT(T0(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(Q0(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 ENDDO C CALL COLLECT(P0(:,:),DUM1) IF(LME) WRITE(LRSTRT2) DUM1 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 isp=rtc() 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',I2.2,'.',A4) LFINFIL=91 CLOSE(LFINFIL) OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER) WRITE(LFINFIL)DONE CLOSE(LFINFIL) IF(IER.NE.0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL: DONE' ENDIF C GO TO 666 667 CONTINUE PRINT*,' QUILT I/O SERVER SHUTTING DOWN NOW' C 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