SUBROUTINE READ_RESTRT !>-------------------------------------------------------------------------------------------------- !> SUBROUTINE READ_RESTRT !> !> SUBPROGRAM: READ_RESTRT - READ AND DISTRIBUTE RESTRT FILE !> PROGRAMMER: BLACK !> ORG: W/NP2 !> DATE: 98-10-22 !> !> ABSTRACT: !> READ_RESTRT READS IN QUANTITIES FROM THE NFC FILE OR THE RESTRT FILE AND DISTRIBUTES THEM TO THE !> OTHER NODES/PES !> !> PROGRAM HISTORY LOG: !v 97-??-?? MEYS - ORIGINATOR !> 97-08-?? BLACK - REWROTE FOR BENCHMARK !> 98-??-?? TUCCILLO - MODIFIED FOR SINGLE OR DOUBLE PRECISION !> 98-10-23 BLACK - MODIFIED FOR NEWEST RESTART FILE !> 18-01-15 LUCCI - MODERNIZATION OF THE CODE, INCLUDING: !> * F77 TO F90/F95 !> * INDENTATION & UNIFORMIZATION CODE !> * REPLACEMENT OF COMMONS BLOCK FOR MODULES !> * DOCUMENTATION WITH DOXYGEN !> * OPENMP FUNCTIONALITY !> !> INPUT ARGUMENT LIST: !> NONE !> !> OUTPUT ARGUMENT LIST: !> NONE !> !> INPUT/OUTPUT ARGUMENT LIST: !> NONE !> !> USE MODULES: ACMCLD !> ACMCLH !> ACMPRE !> ACMRDL !> ACMRDS !> ACMSFC !> BOCO !> CLDWTR !> CNVCLD !> CONTIN !> CTLBLK !> DYNAM !> F77KINDS !> GLB_TABLE !> INDX !> LOOPS !> MAPOT !> MAPPINGS !> MASKS !> MPPCOM !> OUTFIL !> PARMETA !> PARMSOIL !> PARM_TBL !> PHYS !> PRFHLD !> PVRBLS !> SOIL !> TEMPCOM !> TOPO !> VRBLS !> !> DRIVER : INIT !> INITS !> !> CALLS : DSTRB !> IDSTRB !> MPI_BARRIER !> MPI_BCAST !>-------------------------------------------------------------------------------------------------- USE ACMCLD USE ACMCLH USE ACMPRE USE ACMRDL USE ACMRDS USE ACMSFC USE BOCO USE CLDWTR USE CNVCLD USE CONTIN USE CTLBLK USE DYNAM USE F77KINDS USE GLB_TABLE USE INDX USE LOOPS USE MAPOT USE MAPPINGS USE MASKS USE MPPCOM USE OUTFIL USE PARMETA USE PARMSOIL USE PARM_TBL USE PHYS USE PRFHLD USE PVRBLS USE SOIL USE TEMPCOM USE TOPO USE VRBLS ! IMPLICIT NONE ! REAL (KIND=R4KIND), PARAMETER :: D00 = 0.0 REAL (KIND=R4KIND), PARAMETER :: D50 = .50 REAL (KIND=R4KIND), PARAMETER :: H1 = 1.0 REAL (KIND=R4KIND), PARAMETER :: G = 9.8 REAL (KIND=R4KIND), PARAMETER :: CM1 = 2937.4 REAL (KIND=R4KIND), PARAMETER :: CM2 = 4.9283 REAL (KIND=R4KIND), PARAMETER :: CM3 = 23.5518 REAL (KIND=R4KIND), PARAMETER :: EPS = 0.622 REAL (KIND=R4KIND), PARAMETER :: Q2INI = .50 REAL (KIND=R4KIND), PARAMETER :: EPSQ2 = 2.E-2 REAL (KIND=R4KIND), PARAMETER :: EPSQ = 2.E-12 REAL (KIND=R4KIND), PARAMETER :: EPSWET = 0.0 REAL (KIND=R4KIND), PARAMETER :: Z0LAND = .10 REAL (KIND=R4KIND), PARAMETER :: Z0SEA = .001 REAL (KIND=R4KIND), PARAMETER :: FCM = .00001 REAL (KIND=R4KIND), PARAMETER :: DTR = 0.1745329E-1 REAL (KIND=R4KIND), PARAMETER :: H360 = 360.0 REAL (KIND=R4KIND), PARAMETER :: H1905 = 190.5 REAL (KIND=R4KIND), PARAMETER :: H105 = 105.0 ! INTEGER(KIND=I4KIND), PARAMETER :: IMJM = IM * JM - JM / 2 INTEGER(KIND=I4KIND), PARAMETER :: JMP1 = JM + 1 INTEGER(KIND=I4KIND), PARAMETER :: IMT = 2 * IM - 1 !------------------ ! DECLARE VARIABLES !------------------ LOGICAL(KIND=L4KIND) ::& & RUNB ! CHARACTER(32) ::& & LABEL ! CHARACTER(40) ::& & CONTRL , FILALL , FILMST , FILTMP , FILTKE , FILUNV , FILCLD , FILRAD , FILSFC ! REAL (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2) ::& & PSLP ! REAL (KIND=R4KIND), DIMENSION(IM, JM, NSOIL) ::& & TEMPSOIL ! INTEGER(KIND=I4KIND), DIMENSION(3) ::& & IDATB ! INCLUDE "mpif.h" ! #include "sp.h" ! INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE) ::& & ISTAT ! #ifdef DP_REAL ! LOGICAL(KIND=L8KIND) ::& & RUNX , FIRSTX ! INTEGER(KIND=I8KIND), DIMENSION(3) ::& & IDATX ! INTEGER(KIND=I8KIND) ::& & IHRSTX , NTSDX , IOUTX , NSHDEX ! INTEGER(KIND=I8KIND), DIMENSION(IM, JM) ::& & ITEMPX , ITEMP2X ! #endif ! !------------------------ ! IMPLICIT NONE VARIABLES !------------------------ INTEGER(KIND=I4KIND) ::& & I , J , K , N , IER , IRTN , IYR , IMNTH , IDAY , & & LBM2 , IHOUR ! REAL (KIND=R4KIND) ::& & TSTART , PDOMG , RESOMG , DUMMY , TEMP9 , TEMP10 , TEMP11 !------------------------------------ ! TSTART IS THE INITIAL TIME IN HOURS !------------------------------------ TSTART = NSTART * DT / 3600. !----------------------------------------- ! READ INITIAL CONDITIONS OR RESTART FILE. ! FIRST, THE .NOT. RESTART FILE CASE. !----------------------------------------- NFCST = 13 ! ! OPEN(UNIT=NFCST, FILE='INIT.file', STATUS='OLD', FORM='UNFORMATTED') OPEN(UNIT=NFCST,STATUS='OLD',FORM='UNFORMATTED') ! IF (.NOT. RESTRT) THEN IF (MYPE == 0) THEN ! #ifdef DP_REAL ! READ(NFCST) RUNX, IDATX, IHRSTX, NTSDX RUN = RUNX IDAT = IDATX IHRST = IHRSTX NTSD = NTSDX ! #else ! READ(NFCST) RUN, IDAT, IHRST, NTSD ! #endif ! IF (NTSD == 1 ) NTSD = 0 ELSE READ(NFCST) DUMMY END IF ! CALL MPI_BCAST (RUN , 1, MPI_LOGICAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST (IDAT(1), 3, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST (IHRST , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST (NTSD , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BARRIER( MPI_COMM_COMP, IRTN) !-------------- ! DISTRIBUTE PD !-------------- IF (MYPE == 0) THEN READ(NFCST)TEMP1 END IF ! CALL DSTRB(TEMP1, PD, 1, 1, 1) !--------------- ! DISTRIBUTE RES !--------------- IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, RES, 1, 1, 1) !--------------- ! DISTRIBUTE FIS !--------------- IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, FIS, 1, 1, 1) !------------- ! DISTRIBUTE U !------------- DO K=1,LM IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF CALL DSTRB(TEMP1, U, 1, LM, K) END DO !------------- ! DISTRIBUTE V !------------- DO K=1,LM IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF CALL DSTRB(TEMP1, V, 1, LM, K) END DO !------------- ! DISTRIBUTE T !------------- DO K=1,LM IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF CALL DSTRB(TEMP1, T, 1, LM, K) END DO !------------- ! DISTRIBUTE Q !------------- DO K=1,LM IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF CALL DSTRB(TEMP1, Q, 1, LM, K) END DO !-------------- ! DISTRIBUTE SI !-------------- IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, SI, 1, 1, 1) !--------------- ! DISTRIBUTE SNO !--------------- IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, SNO, 1, 1, 1) !--------------- ! DISTRIBUTE SMC !--------------- IF (MYPE == 0) THEN READ(NFCST) TEMPSOIL END IF ! CALL DSTRB(TEMPSOIL, SMC, NSOIL, NSOIL, NSOIL) !--------------- ! DISTRIBUTE CMC !--------------- IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, CMC, 1, 1, 1) !--------------- ! DISTRIBUTE STC !--------------- IF (MYPE == 0) THEN READ(NFCST)TEMPSOIL END IF ! CALL DSTRB(TEMPSOIL, STC, NSOIL, NSOIL, NSOIL) !---------------- ! DISTRIBUTE SH2O !---------------- IF (MYPE == 0) THEN READ(NFCST) TEMPSOIL END IF ! CALL DSTRB(TEMPSOIL, SH2O, NSOIL, NSOIL, NSOIL) !------------------ ! DISTRIBUTE ALBEDO !------------------ IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, ALBEDO, 1, 1, 1) ! IYR = IDAT(3) - 1900 IMNTH = IDAT(1) IDAY = IDAT(2) ! IF (MYPE == 0) WRITE(LIST,*) 'INIT: READ INITIAL CONDITION FILE' !------------------------------- ! SECOND, THE RESTART FILE CASE. !------------------------------- ELSE IF (MYPE == 0) WRITE(LIST,*)'INIT: READ RESTART FILE' ! IF (MYPE == 0) THEN ! READ(NFCST) RUN, IDAT, IHRST, NTSD, LABEL, IHOUR ! IF (NTSD == 1) NTSD = 0 ! READ(NFCST) PDOMG, RESOMG END IF ! CALL MPI_BCAST(RUN , 1, MPI_LOGICAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(IDAT(1), 3, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(IHRST , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(NTSD , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) !------------------ ! DISTRIBUTE OMGALF !------------------ DO K=1,LM IF (MYPE == 0) THEN READ(NFCST) TEMP1 END IF ! CALL DSTRB(TEMP1, OMGALF, 1, LM, K) ! END DO ! IF (MYPE == 0) WRITE(LIST,*)' READ ',LABEL ! IF (MYPE == 0) THEN ! READ(NFCST) RUN, IDAT, IHRST, NTSD, LABEL, IHOUR, FIRST, IOUT, NSHDE ! IF (NTSD == 1) NTSD = 0 END IF ! FIRST = .TRUE. ! CALL MPI_BCAST(RUN , 1, MPI_LOGICAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(IDAT(1), 3, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(IHRST , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(NTSD , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(FIRST , 1, MPI_LOGICAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(IOUT , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(NSHDE , 1, MPI_INTEGER, 0, MPI_COMM_COMP, IRTN) ! IF (MYPE == 0) THEN READ(NFCST) TEMP1, TEMP2, TEMP3 END IF ! CALL DSTRB(TEMP1,PD ,1,1,1) CALL DSTRB(TEMP2,RES,1,1,1) CALL DSTRB(TEMP3,FIS,1,1,1) ! LBM2 = LB * LM * 2 ! IF (MYPE == 0) THEN IF (NINT(TSTART) == 0) THEN READ(NFCST) PDB, TB, QB, UB, VB ELSE READ(NFCST) PDB, TB, QB, UB, VB, Q2B, CWMB END IF END IF ! CALL MPI_BCAST(PDB(1,1) , LB , MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(PDB(1,2) , LB , MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(TB (1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(QB (1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(UB (1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(VB (1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) ! IF (NINT(TSTART) > 0) THEN CALL MPI_BCAST(Q2B (1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) CALL MPI_BCAST(CWMB(1,1,1), LBM2, MPI_REAL, 0, MPI_COMM_COMP, IRTN) END IF !------------------ print*, "read_restrt jump" END IF !--------------------------------------------------- ! DONE READING INITIAL CONDITIONS OR A RESTART FILE. !--------------------------------------------------- ! !------------------------------ ! END OF SUBROUTINE READ_RESTRT !------------------------------ IF (MYPE == 0) THEN WRITE(LIST,*) 'INIT: EXIT READ_RESTRT' WRITE(LIST,*) ' ' END IF ! RETURN ! END SUBROUTINE READ_RESTRT