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) CGSM v100m REAL DUM8(IM,JM),DUM9(IM,JM),DUM10(IM,JM),DUM11(IM,JM) CGSM v100m 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(:,:) CGSM v100m &,TH100(:,:),Q100(:,:),U100(:,:),V100(:,:) CGSM v100m &,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 cligia &,SM(:,:),HBM2(:,:),DETA(:) cligia 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,HYDRO 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 CJLG 20070126 CHARACTER (LEN=200) :: submit ! chou CHARACTER*85 LINE CHARACTER*25 OUTJOB CJLG 20070126 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(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 CJLG 20070126 NAMELIST /POSTLIST/submit !chou CJLG 20070126 C----------------------------------------------------------------------- CALL MPI_FIRST C*** C*** READ NAMELIST FCSTDATA TO FIND OUT IF THIS IS A NESTED RUN C*** LFCSTD=11 open(LFCSTD,file='fcstdata.meso',status='old') READ(LFCSTD,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)) 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(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 cligia ALLOCATE(HBM2(IM,MY_JSD:MY_JED)) ALLOCATE(SM(IM,MY_JSD:MY_JED)) ALLOCATE(DETA(1:LM)) cligia 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) c 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 Chou 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 Chou 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) 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(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 Chou icum=icum+rtc()-ist2 cligia call decoal(deta(1:lm),lm) cligia 200 CONTINUE C Chou 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 Chou ist=rtc() open(unit=NHB,form='unformatted',file='cnst.file') CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP) Chou 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) CJLG Quando submetido com varios processadores a variavel tmmark CJLG nao eh exportada corretamente e a funcao GETENV retorna "vazio" RESTHR='t00s' CJLG 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 Chou 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 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 Chou 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',I6.6,'.',A4) LFINFIL=91 CLOSE(LFINFIL) OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER) WRITE(LFINFIL)DONE CLOSE(LFINFIL) ENDIF OUTJ=.false. IF(OUTJ)THEN IF(LME)THEN CJLG 20070126 CJLG Submete o pos-processamento durante a rodada 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 WRITE(list,*)'CHKOUT: SUBMIT POST JOB ',submit CALL system(submit) ! NEC equivalent CJLG 20070126 IF(IER.NE.0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL: DONE' ENDIF 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