SUBROUTINE QUILT !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBROUTINE: QUILT I/O SERVERS ! PRGRMMR: TUCCILLO ORG: IBM DATE: 00-01-20 ! ABSTRACT: I/O SERVERS ! PROGRAM HISTORY LOG: ! 00-01-20 TUCCILLO - ORIGINATOR ! 00-11-02 BLACK - SLP FOR NEST BOUNDARIES ! 00-12-12 BLACK - RESTART CAPABILITY ! USAGE: CALL QUILT ! INPUT ARGUMENT LIST: ! NONE ! OUTPUT ARGUMENT LIST: ! NONE ! INPUT FILES: NONE ! OUTPUT FILES: NONE ! SUBPROGRAMS CALLED: ! UNIQUE: ! MPI_RECV ! MPI_BCAST ! COLLECT ! SLP ! DECOAL ! EXIT STATES: ! COND = 0 - NORMAL EXIT ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ ! THIS CODE ASSUMES THAT NSOIL IS GE TO 4. IF THIS IS NOT TRUE, ! THE CODE WILL STOP. THE EQUIVALENCING IS THE PROBLEM. !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "parmsoil.f90" INCLUDE "mpif.h" INCLUDE "mpp.h" !----------------------------------------------------------------------- INCLUDE "COMM_PARA.f90" INCLUDE "COMM_BUFFER.f90" !----------------------------------------------------------------------- PARAMETER & (LB=2*IM+JM-3) !----------------------------------------------------------------------- REAL :: DUM1(IM,JM),DUM2(IM,JM),DUM3(IM,JM),DUM4(IM,JM) REAL :: DUM5(IM,JM),DUM6(IM,JM),DUM7(IM,JM) ! SM v100m REAL :: DUM8(IM,JM),DUM9(IM,JM),DUM10(IM,JM),DUM11(IM,JM) ! SM v100m ! Lyra GSM Wind stress REAL :: DUM12(IM,JM),DUM13(IM,JM) ! Lyra GSM Wind stress REAL :: DUMS(IM,JM,NSOIL) INTEGER :: STATUS(MPI_STATUS_SIZE) EQUIVALENCE ( DUM1(1,1), DUMS(1,1,1) ) EQUIVALENCE ( DUM2(1,1), DUMS(1,1,2) ) EQUIVALENCE ( DUM3(1,1), DUMS(1,1,3) ) EQUIVALENCE ( DUM4(1,1), DUMS(1,1,4) ) !----------------------------------------------------------------------- REAL, ALLOCATABLE :: & PDOMG(:,:),RESOMG(:,:),PD(:,:),RES(:,:),FIS(:,:) & ,RSWIN(:,:),RSWOUT(:,:),TG(:,:),Z0(:,:),AKMS(:,:) & ,CZEN(:,:),AKHS(:,:),THS(:,:),QS(:,:),TWBS(:,:) & ,QWBS(:,:),HBOT(:,:),CFRACL(:,:),THZ0(:,:),QZ0(:,:) & ,UZ0(:,:),VZ0(:,:),USTAR(:,:),HTOP(:,:),CFRACM(:,:) & ,SNO(:,:),SI(:,:),CLDEFI(:,:),RF(:,:),PSLP(:,:) & ,CUPPT(:,:),CFRACH(:,:),SOILTB(:,:),SFCEXC(:,:) & ,SMSTAV(:,:),SMSTOT(:,:),GRNFLX(:,:),PCTSNO(:,:) & ,RLWIN(:,:),RADOT(:,:),CZMEAN(:,:),SIGT4(:,:) & ,U00(:,:),SR(:,:),PREC(:,:),ACPREC(:,:),ACCLIQ(:,:) & ,CUPREC(:,:),ACFRCV(:,:),ACFRST(:,:),SFCSHX(:,:) & ,ACSNOW(:,:),ACSNOM(:,:),SSROFF(:,:),BGROFF(:,:) & ,SFCLHX(:,:),SUBSHX(:,:),SNOPCX(:,:),SFCUVX(:,:) & ,SFCEVP(:,:),POTEVP(:,:),ASWIN(:,:),ASWOUT(:,:) & ,ASWTOA(:,:),ALWIN(:,:),ALWOUT(:,:),ALWTOA(:,:) & ! SM v100m ,TH100(:,:),Q100(:,:),U100(:,:),V100(:,:) & ! SM v100m ! Lyra GSM Wind stress ,XMOMFLUX(:,:),YMOMFLUX(:,:) & ! Lyra GSM Wind stress ,TH10(:,:),Q10(:,:),U10(:,:),V10(:,:),TSHLTR(:,:) & ,QSHLTR(:,:),PSHLTR(:,:),CMC(:,:),POTFLX(:,:) & ,TLMIN(:,:),TLMAX(:,:),RSWTOA(:,:),RLWTOA(:,:) & ,CNVBOT(:,:),CNVTOP(:,:),ALBEDO(:,:) & !Lyra GSM Max wind ,MAXWU(:,:),MAXWV(:,:) & !Lyra GSM Max wind ! p ,SM(:,:),HBM2(:,:),DETA(:) ! p REAL :: UL(2*LM) REAL, ALLOCATABLE :: & OMGALF(:,:,:),T(:,:,:),Q(:,:,:),U(:,:,:) & ,V(:,:,:),Q2(:,:,:),TTND(:,:,:),CWM(:,:,:) & ,TRAIN(:,:,:),TCUCN(:,:,:) & ,RSWTT(:,:,:),RLWTT(:,:,:) REAL, ALLOCATABLE :: & SMC(:,:,:),STC(:,:,:),SH2O(:,:,:) REAL :: & PDB(LB,2),TB(LB,LM,2),QB(LB,LM,2),UB(LB,LM,2),VB(LB,LM,2) & ,Q2B(LB,LM,2),CWMB(LB,LM,2) !----------------------------------------------------------------------- INTEGER :: IDAT(3) INTEGER, ALLOCATABLE :: & LC(:,:),NCFRCV(:,:),NCFRST(:,:) !----------------------------------------------------------------------- LOGICAL :: & RUN,FIRST,HYDRO,SIGMA ! p & RUN,FIRST !----------------------------------------------------------------------- CHARACTER & RSTFIL1*50,RSTFIL2*50,RESTHR*4,LABEL*32 & ,FNAME*80,ENVAR*50,BLANK*4 CHARACTER FINFIL*50,DONE*10 CHARACTER (LEN=200) :: submit ! chou CHARACTER (LEN=200) :: chmo CHARACTER(85) :: LINE CHARACTER(25) :: OUTJOB LOGICAL :: LME, OUTJ !----------------------------------------------------------------------- DATA LRSTRT1/21/,LRSTRT2/61/,NHB/12/,BLANK/' '/ !----------------------------------------------------------------------- real*8 :: timef, ist, isp, rtc, ist2, isp2, icum !----------------------------------------------------------------------- REAL,DIMENSION(999999) :: TSHDE REAL,DIMENSION(LSM) :: SPL LOGICAL :: RESTRT,SINGLRST,SUBPOST,NEST,SPLINE ! DECLARE NAMELIST NAMELIST /FCSTDATA/ & TSTART,TEND,TCP,RESTRT,SINGLRST,SUBPOST,NMAP,TSHDE,SPL & ,NPHS,NCNVC,NRADSH,NRADLH,NTDDMP & ,TPREC,THEAT,TCLOD,TRDSW,TRDLW,TSRFC & ,NEST,HYDRO,SPLINE NAMELIST /POSTLIST/chmo NAMELIST /POSTLIST/submit !chou !----------------------------------------------------------------------- CALL MPI_FIRST !*** !*** READ NAMELIST FCSTDATA TO FIND OUT IF THIS IS A NESTED RUN !*** LFCSTD = 11 open(LFCSTD,file='fcstdata.meso',status='old') READ(LFCSTD,FCSTDATA) IF(NSOIL < 4)THEN PRINT*, ' NSOIL IS LESS THAN 4. CHANGE THE EQUIVALENCES' PRINT*, ' STOPPING' CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR) ENDIF IF(ME == 0)THEN LME= .TRUE. ELSE LME= .FALSE. ENDIF ! p ! READ NHB FILE TO OBTAIN SIGMA open(unit=NHB,form='unformatted',file='cnst.file') REWIND NHB READ(NHB)NFCST,NBC,LIST,DT,IDTAD,SIGMA print*,'in quilt, sigma= ',sigma print*,'in quilt, sigma= ',sigma print*,'in quilt, sigma= ',sigma ! p ALLOCATE(PDOMG(IM,MY_JSD:MY_JED)) ALLOCATE(RESOMG(IM,MY_JSD:MY_JED)) ALLOCATE(OMGALF(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(PD(IM,MY_JSD:MY_JED)) ALLOCATE(RES(IM,MY_JSD:MY_JED)) ALLOCATE(FIS(IM,MY_JSD:MY_JED)) ALLOCATE(T(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(Q(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(U(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(V(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(Q2(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(TTND(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(CWM(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(TRAIN(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(TCUCN(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(RSWIN(IM,MY_JSD:MY_JED)) ALLOCATE(RSWOUT(IM,MY_JSD:MY_JED)) ALLOCATE(TG(IM,MY_JSD:MY_JED)) ALLOCATE(Z0(IM,MY_JSD:MY_JED)) ALLOCATE(AKMS(IM,MY_JSD:MY_JED)) ALLOCATE(CZEN(IM,MY_JSD:MY_JED)) ALLOCATE(AKHS(IM,MY_JSD:MY_JED)) ALLOCATE(THS(IM,MY_JSD:MY_JED)) ALLOCATE(QS(IM,MY_JSD:MY_JED)) ALLOCATE(TWBS(IM,MY_JSD:MY_JED)) ALLOCATE(QWBS(IM,MY_JSD:MY_JED)) ALLOCATE(HBOT(IM,MY_JSD:MY_JED)) ALLOCATE(CFRACL(IM,MY_JSD:MY_JED)) ALLOCATE(THZ0(IM,MY_JSD:MY_JED)) ALLOCATE(QZ0(IM,MY_JSD:MY_JED)) ALLOCATE(UZ0(IM,MY_JSD:MY_JED)) ALLOCATE(VZ0(IM,MY_JSD:MY_JED)) ALLOCATE(USTAR(IM,MY_JSD:MY_JED)) ALLOCATE(HTOP(IM,MY_JSD:MY_JED)) ALLOCATE(SNO(IM,MY_JSD:MY_JED)) ALLOCATE(SI(IM,MY_JSD:MY_JED)) ALLOCATE(CLDEFI(IM,MY_JSD:MY_JED)) ALLOCATE(RF(IM,MY_JSD:MY_JED)) ALLOCATE(PSLP(IM,MY_JSD:MY_JED)) ALLOCATE(CUPPT(IM,MY_JSD:MY_JED)) ALLOCATE(CFRACH(IM,MY_JSD:MY_JED)) ALLOCATE(CFRACM(IM,MY_JSD:MY_JED)) ALLOCATE(SOILTB(IM,MY_JSD:MY_JED)) ALLOCATE(SFCEXC(IM,MY_JSD:MY_JED)) ALLOCATE(SMSTAV(IM,MY_JSD:MY_JED)) ALLOCATE(SMSTOT(IM,MY_JSD:MY_JED)) ALLOCATE(GRNFLX(IM,MY_JSD:MY_JED)) ALLOCATE(PCTSNO(IM,MY_JSD:MY_JED)) ALLOCATE(RLWIN(IM,MY_JSD:MY_JED)) ALLOCATE(RADOT(IM,MY_JSD:MY_JED)) ALLOCATE(CZMEAN(IM,MY_JSD:MY_JED)) ALLOCATE(SIGT4(IM,MY_JSD:MY_JED)) ALLOCATE(U00(IM,MY_JSD:MY_JED)) ALLOCATE(LC(IM,MY_JSD:MY_JED)) ALLOCATE(SR(IM,MY_JSD:MY_JED)) ALLOCATE(PREC(IM,MY_JSD:MY_JED)) ALLOCATE(ACPREC(IM,MY_JSD:MY_JED)) ALLOCATE(ACCLIQ(IM,MY_JSD:MY_JED)) ALLOCATE(CUPREC(IM,MY_JSD:MY_JED)) ALLOCATE(ACFRCV(IM,MY_JSD:MY_JED)) ALLOCATE(NCFRCV(IM,MY_JSD:MY_JED)) ALLOCATE(ACFRST(IM,MY_JSD:MY_JED)) ALLOCATE(NCFRST(IM,MY_JSD:MY_JED)) ALLOCATE(ACSNOW(IM,MY_JSD:MY_JED)) ALLOCATE(ACSNOM(IM,MY_JSD:MY_JED)) ALLOCATE(SSROFF(IM,MY_JSD:MY_JED)) ALLOCATE(BGROFF(IM,MY_JSD:MY_JED)) ALLOCATE(SFCSHX(IM,MY_JSD:MY_JED)) ALLOCATE(SFCLHX(IM,MY_JSD:MY_JED)) ALLOCATE(SUBSHX(IM,MY_JSD:MY_JED)) ALLOCATE(SNOPCX(IM,MY_JSD:MY_JED)) ALLOCATE(SFCUVX(IM,MY_JSD:MY_JED)) ALLOCATE(SFCEVP(IM,MY_JSD:MY_JED)) ALLOCATE(POTEVP(IM,MY_JSD:MY_JED)) ALLOCATE(ASWIN(IM,MY_JSD:MY_JED)) ALLOCATE(ASWOUT(IM,MY_JSD:MY_JED)) ALLOCATE(ASWTOA(IM,MY_JSD:MY_JED)) ALLOCATE(ALWIN(IM,MY_JSD:MY_JED)) ALLOCATE(ALWOUT(IM,MY_JSD:MY_JED)) ALLOCATE(ALWTOA(IM,MY_JSD:MY_JED)) ! SM v100m ALLOCATE(TH100(IM,MY_JSD:MY_JED)) ALLOCATE(Q100(IM,MY_JSD:MY_JED)) ALLOCATE(U100(IM,MY_JSD:MY_JED)) ALLOCATE(V100(IM,MY_JSD:MY_JED)) ! SM v100m ! Lyra GSM Wind stress ALLOCATE(XMOMFLUX(IM,MY_JSD:MY_JED)) ALLOCATE(YMOMFLUX(IM,MY_JSD:MY_JED)) ! Lyra GSM Wind stress 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)) !Lyra GSM Max wind ALLOCATE(MAXWU(IM,MY_JSD:MY_JED)) ALLOCATE(MAXWV(IM,MY_JSD:MY_JED)) !Lyra GSM Max wind ALLOCATE(RSWTT(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(RLWTT(IM,MY_JSD:MY_JED,1:LM)) ALLOCATE(CNVBOT(MY_ISD:MY_IED,MY_JSD:MY_JED)) ALLOCATE(CNVTOP(MY_ISD:MY_IED,MY_JSD:MY_JED)) ALLOCATE(RSWTOA(MY_ISD:MY_IED,MY_JSD:MY_JED)) ALLOCATE(RLWTOA(MY_ISD:MY_IED,MY_JSD:MY_JED)) ! p ALLOCATE(HBM2(IM,MY_JSD:MY_JED)) ALLOCATE(SM(IM,MY_JSD:MY_JED)) ALLOCATE(DETA(1:LM)) ! p !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** !*** LOOP OVER ALL THE OUTPUT TIMES !*** !----------------------------------------------------------------------- 666 CONTINUE IF(ME == 0)THEN CALL MPI_RECV(IHOUR,1,MPI_INTEGER,0,0,MPI_COMM_INTER,STATUS,IER) PRINT*,' ihour in quilt = ',IHOUR ENDIF CALL MPI_BCAST(IHOUR,1,MPI_INTEGER,0,MPI_COMM_COMP,IER) IF(IHOUR == -999)GO TO 667 ! IST=RTC() ! ICUM=0. !----------------------------------------------------------------------- DO 200 IXXX=1,JEND(ME)-JSTA(ME)+1 !----------------------------------------------------------------------- !*** !*** RECEIVE ALL THE DATA FROM CHKOUT FROM !*** THE APPROPRIATE FORECAST TASKS !*** ist=timef() CALL MPI_RECV(BUF,IBUFMAX,MPI_REAL,MPI_ANY_SOURCE,IHOUR, & MPI_COMM_INTER,STATUS,IER) IPE=STATUS(MPI_SOURCE) IF(IER /= 0)THEN PRINT*,' error from mpi_rec = ',IER ENDIF ! ist2 = rtc() IS=MY_IS_GLB_A(IPE) IE=MY_IE_GLB_A(IPE) JS=MY_JS_GLB_A(IPE) JE=MY_JE_GLB_A(IPE) LEN_CH=(IE-IS+1)*(JE-JS+1) ! EXTRACT RECORD LENGTH - LETS KEEP THIS BECAUSE IT IS POTENTIALLY HANDY CALL DECOAL(IDUM,-1) CALL DECOAL(RUN,1) CALL DECOAL(IDAT,3) CALL DECOAL(IHRST,1) CALL DECOAL(NTSD,1) CALL DECOAL(LABEL,8) CALL DECOAL(PDOMG(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RESOMG(IS:IE,JS:JE),LEN_CH) DO L=1,LM CALL DECOAL(OMGALF(IS:IE,JS:JE,L),LEN_CH) ENDDO CALL DECOAL(RUN,1) CALL DECOAL(IDAT,3) CALL DECOAL(IHRST,1) CALL DECOAL(NTSD,1) CALL DECOAL(LABEL,8) CALL DECOAL(FIRST,1) CALL DECOAL(IOUT,1) CALL DECOAL(NSHDE,1) CALL DECOAL(PD(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RES(IS:IE,JS:JE),LEN_CH) CALL DECOAL(FIS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(PDB,LB*2) CALL DECOAL(TB,LB*LM*2) CALL DECOAL(QB,LB*LM*2) CALL DECOAL(UB,LB*LM*2) CALL DECOAL(VB,LB*LM*2) CALL DECOAL(Q2B,LB*LM*2) CALL DECOAL(CWMB,LB*LM*2) DO L=1,LM CALL DECOAL(T(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(Q(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(U(IS:IE,JS:JE,l),LEN_CH) CALL DECOAL(V(IS:IE,JS:JE,l),LEN_CH) CALL DECOAL(Q2(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(TTND(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(CWM(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(TRAIN(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(TCUCN(IS:IE,JS:JE,L),LEN_CH) ENDDO CALL DECOAL(RUN,1) CALL DECOAL(IDAT,3) CALL DECOAL(IHRST,1) CALL DECOAL(NTSD,1) CALL DECOAL(LABEL,8) CALL DECOAL(RSWIN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RSWOUT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(TG(IS:IE,JS:JE),LEN_CH) CALL DECOAL(Z0(IS:IE,JS:JE),LEN_CH) CALL DECOAL(AKMS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CZEN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(AKHS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(THS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(QS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(TWBS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(QWBS(IS:IE,JS:JE),LEN_CH) CALL DECOAL(HBOT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CFRACL(IS:IE,JS:JE),LEN_CH) CALL DECOAL(THZ0(IS:IE,JS:JE),LEN_CH) CALL DECOAL(QZ0(IS:IE,JS:JE),LEN_CH) CALL DECOAL(UZ0(IS:IE,JS:JE),LEN_CH) CALL DECOAL(VZ0(IS:IE,JS:JE),LEN_CH) CALL DECOAL(USTAR(IS:IE,JS:JE),LEN_CH) CALL DECOAL(HTOP(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CFRACM(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SNO(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SI(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CLDEFI(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RF(IS:IE,JS:JE),LEN_CH) CALL DECOAL(PSLP(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CUPPT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CFRACH(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SOILTB(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SFCEXC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SMSTAV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SMSTOT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(GRNFLX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(PCTSNO(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RLWIN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RADOT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CZMEAN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SIGT4(IS:IE,JS:JE),LEN_CH) CALL DECOAL(U00(IS:IE,JS:JE),LEN_CH) CALL DECOAL(UL,2*LM) CALL DECOAL(LC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SR(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RUN,1) CALL DECOAL(IDAT,3) CALL DECOAL(IHRST,1) CALL DECOAL(NTSD,1) CALL DECOAL(LABEL,8) CALL DECOAL(PREC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACPREC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACCLIQ(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CUPREC(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACFRCV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(NCFRCV(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACFRST(IS:IE,JS:JE),LEN_CH) CALL DECOAL(NCFRST(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACSNOW(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ACSNOM(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SSROFF(IS:IE,JS:JE),LEN_CH) CALL DECOAL(bgroff(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SFCSHX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SFCLHX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SUBSHX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SNOPCX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SFCUVX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(SFCEVP(IS:IE,JS:JE),LEN_CH) CALL DECOAL(POTEVP(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ASWIN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ASWOUT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ASWTOA(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ALWIN(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ALWOUT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ALWTOA(IS:IE,JS:JE),LEN_CH) CALL DECOAL(ARDSW,1) CALL DECOAL(ARDLW,1) CALL DECOAL(ASRFC,1) CALL DECOAL(AVRAIN,1) CALL DECOAL(AVCNVC,1) CALL DECOAL(TH10(IS:IE,JS:JE),LEN_CH) CALL DECOAL(Q10(IS:IE,JS:JE),LEN_CH) CALL DECOAL(U10(IS:IE,JS:JE),LEN_CH) CALL DECOAL(V10(IS:IE,JS:JE),LEN_CH) CALL DECOAL(TSHLTR(IS:IE,JS:JE),LEN_CH) CALL DECOAL(QSHLTR(IS:IE,JS:JE),LEN_CH) CALL DECOAL(PSHLTR(IS:IE,JS:JE),LEN_CH) ! SM v100m CALL DECOAL(TH100(IS:IE,JS:JE),LEN_CH) CALL DECOAL(Q100(IS:IE,JS:JE),LEN_CH) CALL DECOAL(U100(IS:IE,JS:JE),LEN_CH) CALL DECOAL(V100(IS:IE,JS:JE),LEN_CH) ! SM v100m ! Lyra GSM Wind stress CALL DECOAL(XMOMFLUX(IS:IE,JS:JE),LEN_CH) CALL DECOAL(YMOMFLUX(IS:IE,JS:JE),LEN_CH) ! Lyra GSM Wind stress 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) !Lyra GSM Max wind CALL DECOAL(MAXWU(IS:IE,JS:JE),LEN_CH) CALL DECOAL(MAXWV(IS:IE,JS:JE),LEN_CH) !Lyra GSM Max wind CALL DECOAL(ACUTIM,1) CALL DECOAL(ARATIM,1) CALL DECOAL(APHTIM,1) CALL DECOAL(NHEAT,1) CALL DECOAL(NPHS,1) CALL DECOAL(NCNVC,1) CALL DECOAL(NPREC,1) CALL DECOAL(NRDSW,1) CALL DECOAL(NRDLW,1) CALL DECOAL(NSRFC,1) CALL DECOAL(TPH0D,1) CALL DECOAL(TLM0D,1) CALL DECOAL(RESTRT,1) DO L=1,LM CALL DECOAL(RSWTT(IS:IE,JS:JE,L),LEN_CH) CALL DECOAL(RLWTT(IS:IE,JS:JE,L),LEN_CH) enddo CALL DECOAL(CNVBOT(IS:IE,JS:JE),LEN_CH) CALL DECOAL(CNVTOP(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RSWTOA(IS:IE,JS:JE),LEN_CH) CALL DECOAL(RLWTOA(IS:IE,JS:JE),LEN_CH) ! icum = icum + rtc() -ist2 ! p added for slpsig stuff call decoal(hbm2(is:ie,js:je),len_ch) call decoal(sm(is:ie,js:je),len_ch) call decoal(spl(1:lsm),lsm) call decoal(deta(1:lm),lm) call decoal(pt,1) call decoal(spline,1) write(6,*) 'decoaled in QUILT that SPLINE= ', SPLINE ! p 200 END DO ! isp=rtc() ! PRINT*,' TIME FOR RECV/ASSEMBLY = ',isp-ist ! PRINT*,' TIME FOR DECOAL = ',icum !----------------------------------------------------------------------- !*** !*** BEFORE WRITING OUT THE RESTRT FILE, COMPUTE THE MSLP !*** ! ist=rtc() ! p CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP) IF(SIGMA)THEN if(spline)then print*,'calling slpsigspline' call slpsigspline(PD,FIS,T,Q,SPL,LSM & , DETA,PT,PSLP) else print*,'calling slpsig' CALL SLPSIG(PD,FIS,SM,T,Q,CWM,HBM2,U00,SPL,LSM & , UL,DETA,PT,PSLP) end if ELSE print*,'calling slp' CALL SLP(NHB,PD,RES,FIS,T,Q,NTSD,NEST,PSLP) END IF ! isp=rtc() ! PRINT*,' time for SLP = ',isp-ist !----------------------------------------------------------------------- !*** WRITE OUT THE GLOBAL RESTRT FILE. !----------------------------------------------------------------------- !*** !*** GENERATE THE NAME OF THE GLOBAL OUTPUT RESTRT FILE !*** ENVAR=' ' CALL GETENV("RSTFNL",ENVAR) CALL GETENV("tmmark",RESTHR) RESTHR='t00s' KPATH = INDEX(ENVAR,' ') -1 IF(KPATH <= 0) KPATH = LEN(ENVAR) IF(RESTHR == ' ')THEN WRITE(RSTFIL2,280)IHOUR 280 FORMAT('restrt',I6.6) ELSE WRITE(RSTFIL2,285)IHOUR,RESTHR 285 FORMAT('restrt',I6.6,'.',a4) ENDIF KRST=INDEX(RSTFIL2,' ') -1 IF(KRST <= 0)KRST=LEN(RSTFIL2) !*** !*** OPEN UNIT TO THE GLOBAL RESTART FILE !*** CLOSE(LRSTRT2) ! ist = rtc() IF(ENVAR(1:4) == BLANK)THEN OPEN(UNIT=LRSTRT2,FILE=RSTFIL2,FORM='UNFORMATTED',IOSTAT=IER) ELSE FNAME=ENVAR(1:KPATH) // RSTFIL2(1:KRST) OPEN(UNIT=LRSTRT2,FILE=FNAME,FORM='UNFORMATTED',IOSTAT=IER) ENDIF !----------------------------------------------------------------------- IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour CALL COLLECT(PDOMG,DUM1) CALL COLLECT(RESOMG,DUM2) IF(LME)WRITE(LRSTRT2)DUM1,DUM2 DO L=1,LM CALL COLLECT(OMGALF(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 ENDDO IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour, & FIRST,IOUT,NSHDE CALL COLLECT(PD,DUM1) CALL COLLECT(RES,DUM2) CALL COLLECT(FIS,DUM3) IF(LME)WRITE(LRSTRT2) DUM1, DUM2, DUM3 IF(LME)WRITE(LRSTRT2)PDB,TB,QB,UB,VB,Q2B,CWMB DO L=1,LM CALL COLLECT(T(:,:,L),DUM1) ! IF(LME)WRITE(99) DUM1 IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(Q(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(U(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(V(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(Q2(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(TTND(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(CWM(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(TRAIN(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(TCUCN(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 ENDDO CALL COLLECT(RSWIN,DUM1) CALL COLLECT(RSWOUT,DUM2) CALL COLLECT(TG,DUM3) CALL COLLECT(Z0,DUM4) CALL COLLECT(AKMS,DUM5) CALL COLLECT(CZEN,DUM6) IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour & , DUM1,DUM2,DUM3,DUM4,DUM5,DUM6 CALL COLLECT(AKHS,DUM1) CALL COLLECT(THS,DUM2) CALL COLLECT(QS,DUM3) CALL COLLECT(TWBS,DUM4) CALL COLLECT(QWBS,DUM5) CALL COLLECT(HBOT,DUM6) CALL COLLECT(CFRACL,DUM7) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 CALL COLLECT(THZ0,DUM1) CALL COLLECT(QZ0,DUM2) CALL COLLECT(UZ0,DUM3) CALL COLLECT(VZ0,DUM4) CALL COLLECT(USTAR,DUM5) CALL COLLECT(HTOP,DUM6) CALL COLLECT(CFRACM,DUM7) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 CALL COLLECT(SNO,DUM1) CALL COLLECT(SI,DUM2) CALL COLLECT(CLDEFI,DUM3) CALL COLLECT(RF,DUM4) CALL COLLECT(PSLP,DUM5) CALL COLLECT(CUPPT,DUM6) CALL COLLECT(CFRACH,DUM7) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 CALL COLLECT(SOILTB,DUM1) CALL COLLECT(SFCEXC,DUM2) CALL COLLECT(SMSTAV,DUM3) CALL COLLECT(SMSTOT,DUM4) CALL COLLECT(GRNFLX,DUM5) CALL COLLECT(PCTSNO,DUM6) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4,DUM5,DUM6 CALL COLLECT(RLWIN,DUM1) CALL COLLECT(RADOT,DUM2) CALL COLLECT(CZMEAN,DUM3) CALL COLLECT(SIGT4,DUM4) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4 CALL COLLECT(U00,DUM1) CALL COLLECT(LC,DUM2) CALL COLLECT(SR,DUM3) IF(LME)WRITE(LRSTRT2)DUM1,UL,DUM2,DUM3 CALL COLLECT(PREC,DUM1) CALL COLLECT(ACPREC,DUM2) CALL COLLECT(ACCLIQ,DUM3) CALL COLLECT(CUPREC,DUM4) IF(LME)WRITE(LRSTRT2)RUN,IDAT,IHRST,NTSD,LABEL,ihour & , DUM1,DUM2,DUM3,DUM4 CALL COLLECT(ACFRCV,DUM1) CALL COLLECT(NCFRCV,DUM2) CALL COLLECT(ACFRST,DUM3) CALL COLLECT(NCFRST,DUM4) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4 CALL COLLECT(ACSNOW,DUM1) CALL COLLECT(ACSNOM,DUM2) CALL COLLECT(SSROFF,DUM3) CALL COLLECT(BGROFF,DUM4) IF(LME)WRITE(LRSTRT2) DUM1,DUM2,DUM3,DUM4 CALL COLLECT(SFCSHX,DUM1) CALL COLLECT(SFCLHX,DUM2) CALL COLLECT(SUBSHX,DUM3) CALL COLLECT(SNOPCX,DUM4) CALL COLLECT(SFCUVX,DUM5) CALL COLLECT(SFCEVP,DUM6) CALL COLLECT(POTEVP,DUM7) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 CALL COLLECT(ASWIN,DUM1) CALL COLLECT(ASWOUT,DUM2) CALL COLLECT(ASWTOA,DUM3) CALL COLLECT(ALWIN,DUM4) CALL COLLECT(ALWOUT,DUM5) CALL COLLECT(ALWTOA,DUM6) IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6 IF(LME)WRITE(LRSTRT2)ARDSW,ARDLW,ASRFC,AVRAIN,AVCNVC CALL COLLECT(TH10,DUM1) CALL COLLECT(Q10,DUM2) CALL COLLECT(U10,DUM3) CALL COLLECT(V10,DUM4) CALL COLLECT(TSHLTR,DUM5) CALL COLLECT(QSHLTR,DUM6) CALL COLLECT(PSHLTR,DUM7) ! SM V100m CALL COLLECT(TH100,DUM8) CALL COLLECT(Q100,DUM9) CALL COLLECT(U100,DUM10) CALL COLLECT(V100,DUM11) ! SM V100m ! Lyra Wind stress CALL COLLECT(XMOMFLUX,DUM12) CALL COLLECT(YMOMFLUX,DUM13) ! Lyra Wind stress IF(LME)WRITE(LRSTRT2)DUM1,DUM2,DUM3,DUM4,DUM5,DUM6,DUM7 & ! SM V100m , DUM8,DUM9,DUM10,DUM11 & ! SM V100m ! Lyra GSM Wind stress , DUM12,DUM13 ! Lyra GSM Wind stress DO L=1,NSOIL CALL COLLECT(SMC(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS CALL COLLECT(CMC,DUM1) IF(LME)WRITE(LRSTRT2) DUM1 DO L=1,NSOIL CALL COLLECT(STC(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS DO L=1,NSOIL CALL COLLECT(SH2O(:,:,L), DUMS(:,:,L)) ENDDO IF(LME)WRITE(LRSTRT2) DUMS CALL COLLECT(ALBEDO,DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(POTFLX,DUM1) CALL COLLECT(TLMIN,DUM2) CALL COLLECT(TLMAX,DUM3) ! Lyra GSM Max wind CALL COLLECT(MAXWU,DUM4) CALL COLLECT(MAXWV,DUM5) ! Lyra GSM Max wind IF(LME)WRITE(LRSTRT2) DUM1, DUM2, DUM3 & ! Lyra GSM Max wind , DUM4, DUM5 & ! Lyra GSM Max wind , ACUTIM,ARATIM,APHTIM & , NHEAT,NPHS,NCNVC,NPREC,NRDSW,NRDLW,NSRFC & , TPH0D,TLM0D,RESTRT DO L=1,LM CALL COLLECT(RSWTT(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 CALL COLLECT(RLWTT(:,:,L),DUM1) IF(LME)WRITE(LRSTRT2) DUM1 ENDDO CALL COLLECT(CNVBOT(:,:),DUM1) IF(LME) WRITE(LRSTRT2) DUM1 CALL COLLECT(CNVTOP(:,:),DUM1) IF(LME) WRITE(LRSTRT2) DUM1 CALL COLLECT(RSWTOA(:,:),DUM1) IF(LME) WRITE(LRSTRT2) DUM1 CALL COLLECT(RLWTOA(:,:),DUM1) IF(LME) WRITE(LRSTRT2) DUM1 CLOSE(LRSTRT2) ! isp=rtc() IF(LME)THEN ! PRINT*,' time for I/O = ',isp-ist ENDIF !----------------------------------------------------------------------- ! SM - Altera\E7\E3o feita para o IO - Para n\E3o mais escrever o outjob e fcstdone OUTJ= .TRUE. IF(OUTJ)THEN IF(LME)THEN DONE='DONE' ITAG=ihour WRITE(FINFIL,1190)ITAG,RESTHR 1190 FORMAT('fcstdone',I6.6,'.',A4) LFINFIL=91 CLOSE(LFINFIL) OPEN(UNIT=LFINFIL,FILE=FINFIL,FORM='UNFORMATTED',IOSTAT=IER) WRITE(LFINFIL)DONE CLOSE(LFINFIL) ! LG ! SM REWIND(11) ! SM READ(11,POSTLIST) ! chou ! SM WRITE(LIST,POSTLIST) ! chou ! SM WRITE(outjob,1240)ITAG ! SM 1240 FORMAT('outjob_special',I6.6,'.ksh') ! SM lunin = 67 ! SM lunot = 68 ! SM OPEN(lunin,FILE='outjob_special.ksh') ! SM OPEN(lunot,FILE=outjob) ! SM 1260 FORMAT(a85) ! SM REWIND(lunin) ! SM DO i=1,11 ! SM READ(lunin,1260) line ! SM idx=index(line,' ')-1 ! SM WRITE(lunot,1260) line ! SM ENDDO ! SM 1261 FORMAT('Hfct=',I6.6) ! SM WRITE(lunot,1261) ITAG ! SM 1250 READ(lunin,1260,END=1290) line ! SM WRITE(lunot,1260) line ! SM GO TO 1250 ! SM 1290 CONTINUE ! SM close(lunot) ! SM close(lunin) ! SM idx=index(submit,'#')-1 ! SM submit = submit(1:idx) // outjob ! SM chx=index(chmo,'#')-1 ! SM chmo = chmo(1:chx) // outjob ! SM CALL system(chmo) ! SM WRITE(list,*)'CHKOUT: SUBMIT POST JOB ',submit ! SM CALL system(submit) ! NEC equivalent ! LG IF(IER /= 0)WRITE(LIST,*)' SIGNAL SENT TO FINFIL: DONE' ENDIF ENDIF GO TO 666 667 CONTINUE PRINT*,' QUILT I/O SERVER SHUTTING DOWN NOW' END SUBROUTINE QUILT !----------------------------------------------------------------------- !----------------------------------------------------------------------- SUBROUTINE DECOAL(A,LEN_CH) INCLUDE "COMM_BUFFER.f90" REAL :: A(*) IF(LEN_CH < 0)THEN IP=0 ENDIF DO I=1,ABS(LEN_CH) IP=IP+1 A(I)=BUF(IP) ENDDO END SUBROUTINE DECOAL