C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE READ_RESTRT C ****************************************************************** C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . C SUBPROGRAM: READ_RESTRT READ AND DISTRIBUTE RESTRT FILE C PRGRMMR: BLACK ORG: W/NP2 DATE: 98-10-22 C C ABSTRACT: C READ_RESTRT READS IN QUANTITIES FROM THE NFC FILE OR THE C RESTRT FILE AND DISTRIBUTES THEM TO THE OTHER NODES/PEs C C PROGRAM HISTORY LOG: C 97-??-?? MEYS - ORIGINATOR C 97-08-?? BLACK - REWROTE FOR BENCHMARK C 98-??-?? TUCCILLO - MODIFIED FOR SINGLE OR DOUBLE PRECISION C 98-10-23 BLACK - MODIFIED FOR NEWEST RESTART FILE C C USAGE: CALL READ_RESTRT FROM SUBROUTINE INIT C INPUT ARGUMENT LIST: C NONE C C OUTPUT ARGUMENT LIST: C NONE C C OUTPUT FILES: C NONE C C SUBPROGRAMS CALLED: C UNIQUE: DSTRB C IDSTRB C C LIBRARY: NONE C C COMMON BLOCKS: CTLBLK C LOOPS C MASKS C DYNAM C PHYS2 C MAPOT1 C VRBLS C CONTIN C NHYDRO C PVRBLS C BOCO C ACMCLH C ACMCLD C ACMPRE C ACMRDL C ACMRDS C ACMSFC C CLDWTR C CNVCLD C SOIL C INDX C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE : IBM SP C$$$ C----------------------------------------------------------------------- C INCLUDE/SET PARAMETERS. C----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "parm.tbl" INCLUDE "parmsoil" C----------------------------------------------------------------------- P A R A M E T E R & (D00=0.0,D50=.50,H1=1.0,G=9.806 &, CM1=2937.4,CM2=4.9283,CM3=23.5518,EPS=0.622 C CVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV C &, Q2INI=.01E0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=1.0E0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=.50E0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=1.E-4 C &, Q2INI=.01E0,EPSQ2=1.E-4,EPSQ=2.E-12,EPSWET=0.0E0 &, Q2INI=.50,EPSQ2=1.E-2,EPSQ=2.E-12,EPSWET=0.0 CAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA &, Z0LAND=.10,Z0SEA=.001,FCM=.00001 &, DTR=0.1745329E-1,H360=360.0 &, H1905=190.5,H105=105.0) C C----------------------------------------------------------------------- P A R A M E T E R & (IMJM=IM*JM-JM/2,JMP1=JM+1,JAM=6+2*(JM-10),LB=2*IM+JM-3 &, LM1=LM-1,LP1=LM+1,IMT=2*IM-1) P A R A M E T E R & (NHRZ=(IDIM2-IDIM1+1)*(JDIM2-JDIM1+1)) C C----------------------------------------------------------------------- C C DECLARE VARIABLES C C----------------------------------------------------------------------- L O G I C A L & RUN,RUNB,FIRST,RESTRT,SIGMA C----------------------------------------------------------------------- C H A R A C T E R *32 & LABEL C H A R A C T E R *40 & CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV &,FILCLD,FILRAD,FILSFC C----------------------------------------------------------------------- R E A L & PSLP(IDIM1:IDIM2,JDIM1:JDIM2),DUM(IDIM1:IDIM2,JDIM1:JDIM2,LM) R E A L & TEMPSOIL(IM,JM,NSOIL) C----------------------------------------------------------------------- I N T E G E R & IDATB(3) C----------------------------------------------------------------------- C C INCLUDE COMMON BLOCKS. C INCLUDE "CTLBLK.comm" INCLUDE "LOOPS.comm" INCLUDE "MASKS.comm" INCLUDE "DYNAM.comm" INCLUDE "PHYS2.comm" INCLUDE "MAPOT1.comm" INCLUDE "VRBLS.comm" INCLUDE "CONTIN.comm" INCLUDE "NHYDRO.comm" INCLUDE "PVRBLS.comm" INCLUDE "BOCO.comm" INCLUDE "ACMCLH.comm" INCLUDE "ACMCLD.comm" INCLUDE "ACMPRE.comm" INCLUDE "ACMRDL.comm" INCLUDE "ACMRDS.comm" INCLUDE "ACMSFC.comm" INCLUDE "PRFHLD.comm" INCLUDE "CLDWTR.comm" INCLUDE "DUST8.comm" INCLUDE "CNVCLD.comm" INCLUDE "C_FRACN.comm" INCLUDE "SOIL.comm" INCLUDE "INDX.comm" C C----------------------------------------------------------------------- INCLUDE "mpif.h" INCLUDE "mpp.h" C----------------------------------------------------------------------- INTEGER ISTAT(MPI_STATUS_SIZE) C C*********************************************************************** C*********************************************************************** C C*** TSTART IS THE INITIAL TIME IN HOURS C TSTART=NSTART*DT/3600. C C READ INITIAL CONDITIONS OR RESTART FILE. C FIRST, THE .NOT. RESTART FILE CASE. C c open(2,file="../../output/ALPHA2.SAMUM" c . ,form="unformatted",status="old") c read(2) temp1 c close(2) c open(2,file="../../output/USGSPREF.SAMUM" c . ,form="unformatted",status="old") c read(2) temp1 c close(2) c open(2,file="../../output/PREF.DAT" c . ,form="unformatted",status="old") c open(2,file="../../output/DALBEDO.dat" c . ,form="unformatted",status="old") c read(2) temp1 c close(2) c open(2,file="../../output/MASKA.dat" c open(2,file="../../output/ZINO4X.DAT" ! open(2,file="../../output/ZINO2X.DAT" c open(2,file="../../output/ZINO_NEW.DAT" open(2,file="../../output/PREF.DAT" . ,form="unformatted",status="old") read(2) temp1 close(2) cpj OPEN(NFCST,FILE= +'../../output/preproc.const.nfcst2d' &,STATUS='UNKNOWN',FORM='UNFORMATTED') IF(.NOT.RESTRT)THEN IF(MYPE.EQ.0)THEN READ(NFCST)RUN,IDAT,IHRST,NTSD !!!!!! NTSD=MAX(NTSD-1,0) NTSD=MAX(NTSD,0) ELSE READ(NFCST)DUMMY ENDIF C 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) C CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) C---------------------------------------------------------------------- C*** CALL DSTRB(TEMP1,snd8,1,1,1) cmairjam-ana claysiltnickotex.dat ! open(2,file="../../output/claysiltnickotex.dat" !AM: open(2,file="../../output/ALPHA2.sltcly" c open(2,file="../../output/sltcly.dat" & ,form="unformatted",status="old") read(2) temp1 CALL DSTRB(TEMP1,dlt8s,1,1,1) read(2) temp1 CALL DSTRB(TEMP1,dlt8c,1,1,1) close(2) C*** DISTRIBUTE PD C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ PD' ENDIF C CALL DSTRB(TEMP1,PD,1,1,1) C C2345678901234567890123456789012345678901234567890123456789012345678901 C---------------------------------------------------------------------- C*** C*** DISTRIBUTE RES C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ RES' ENDIF C CALL DSTRB(TEMP1,RES,1,1,1) C---------------------------------------------------------------------- C*** C*** DISTRIBUTE FIS C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ FIS' ENDIF C CALL DSTRB(TEMP1,FIS,1,1,1) C---------------------------------------------------------------------- C*** C*** DISTRIBUTE U C*** DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ U' ENDIF CALL DSTRB(TEMP1,U,1,LM,L) ENDDO C---------------------------------------------------------------------- C*** C*** DISTRIBUTE V C*** DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ V' ENDIF CALL DSTRB(TEMP1,V,1,LM,L) ENDDO C---------------------------------------------------------------------- C*** C*** DISTRIBUTE T C*** DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ T' ENDIF CALL DSTRB(TEMP1,T,1,LM,L) ENDDO C---------------------------------------------------------------------- C*** C*** DISTRIBUTE Q C*** IDSTP = RDSTP DO L=1,LM IF(MYPE.EQ.0)THEN c READ(NFCST)TEMP1 cpazipejaN-init s8! c READ(NFCST)TEMP1,(temp2,m=1,8) READ(NFCST)TEMP1 ! ,temp2,temp3,temp4,temp5,temp6,temp7,temp8,temp9 WRITE(0,*)'READ Q' WRITE(0,*)'READ S8 pm=',IDSTP ENDIF CALL DSTRB(TEMP1,Q,1,LM,L) c CALL DSTRB(TEMP2,S8,1,LM,L) c CALL DSTRB(TEMP2,S8(:,:,:,1),1,LM,L) c CALL DSTRB(TEMP3,S8(:,:,:,2),1,LM,L) c CALL DSTRB(TEMP4,S8(:,:,:,3),1,LM,L) c CALL DSTRB(TEMP5,S8(:,:,:,4),1,LM,L) c CALL DSTRB(TEMP6,S8(:,:,:,5),1,LM,L) c CALL DSTRB(TEMP7,S8(:,:,:,6),1,LM,L) c CALL DSTRB(TEMP8,S8(:,:,:,7),1,LM,L) c CALL DSTRB(TEMP9,S8(:,:,:,8),1,LM,L) ENDDO c WRITE(0,*)' S8 =',S8 c WRITE(0,*)' READ_RSTRT S8x=',maxval(S8) c WRITE(*,*)' READ_RSTRT S8x=',maxval(S8) c open(2,file="../../output/s8nudg.bin" c IF(MYPE.EQ.0)THEN c open(2,file="../../output/msg.bin" c . ,form="unformatted",status="old",err=1004) c READ(2)temp2 c close (2) c ENDIF c CALL DSTRB(TEMP2,SNUDG,1,1,1) c1004 continue ! IF(MYPE.EQ.0)THEN open(2,file="../../output/s8.bin" . ,form="unformatted",status="old",err=1000) print *,"otvorio:s8.bin" endif DO L=1,LM IF(MYPE.EQ.0)THEN READ(2)temp2,temp3,temp4,temp5,temp6,temp7,temp8,temp9 WRITE(0,*)'READ S8nudg pm=',IDSTP ENDIF CALL DSTRB(TEMP2,S8(:,:,:,1),1,LM,L) CALL DSTRB(TEMP3,S8(:,:,:,2),1,LM,L) CALL DSTRB(TEMP4,S8(:,:,:,3),1,LM,L) CALL DSTRB(TEMP5,S8(:,:,:,4),1,LM,L) CALL DSTRB(TEMP6,S8(:,:,:,5),1,LM,L) CALL DSTRB(TEMP7,S8(:,:,:,6),1,LM,L) CALL DSTRB(TEMP8,S8(:,:,:,7),1,LM,L) CALL DSTRB(TEMP9,S8(:,:,:,8),1,LM,L) c CALL DSTRB(TEMP2,S8NUDG(:,:,:,1),1,LM,L) c CALL DSTRB(TEMP3,S8NUDG(:,:,:,2),1,LM,L) c CALL DSTRB(TEMP4,S8NUDG(:,:,:,3),1,LM,L) c CALL DSTRB(TEMP5,S8NUDG(:,:,:,4),1,LM,L) c CALL DSTRB(TEMP6,S8NUDG(:,:,:,5),1,LM,L) c CALL DSTRB(TEMP7,S8NUDG(:,:,:,6),1,LM,L) c CALL DSTRB(TEMP8,S8NUDG(:,:,:,7),1,LM,L) c CALL DSTRB(TEMP9,S8NUDG(:,:,:,8),1,LM,L) ENDDO c close(2) WRITE(0,*)' xREAD_RSTRT S8x=',maxval(S8) 1000 continue IF(MYPE.EQ.0)THEN open(3,file="../../output/s8nudg.bin" . ,form="unformatted",status="old",err=1001) print *,"otvorio:s8nudg.bin" ENDIF DO L=1,LM IF(MYPE.EQ.0)THEN READ(3)temp2,temp3,temp4,temp5,temp6,temp7,temp8,temp9 WRITE(0,*)'READ S8nudg pm=',IDSTP ENDIF CALL DSTRB(TEMP2,S8NUDG(:,:,:,1),1,LM,L) CALL DSTRB(TEMP3,S8NUDG(:,:,:,2),1,LM,L) CALL DSTRB(TEMP4,S8NUDG(:,:,:,3),1,LM,L) CALL DSTRB(TEMP5,S8NUDG(:,:,:,4),1,LM,L) CALL DSTRB(TEMP6,S8NUDG(:,:,:,5),1,LM,L) CALL DSTRB(TEMP7,S8NUDG(:,:,:,6),1,LM,L) CALL DSTRB(TEMP8,S8NUDG(:,:,:,7),1,LM,L) CALL DSTRB(TEMP9,S8NUDG(:,:,:,8),1,LM,L) ENDDO WRITE(0,*)' READ_RSTRT S8nudgx=',maxval(S8nudg) ! WRITE(*,*)' READ_RSTRT S8nudgx=',maxval(S8nudg) c close(3) 1001 continue C---------------------------------------------------------------------- C*** c*** distribute si C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! write(0,*)'read si' ENDIF C CALL DSTRB(TEMP1,si,1,1,1) C---------------------------------------------------------------------- C*** C*** DISTRIBUTE SNO C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ SNO' ENDIF C CALL DSTRB(TEMP1,SNO,1,1,1) C---------------------------------------------------------------------- C*** C*** DISTRIBUTE SMC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMPSOIL c WRITE(0,*)'READ SMC' !zjvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! do k=1,4 ! do j=1,jm ! do i=1,im ! if(fis(i,j).gt.24000.) then ! tempsoil(i,j,k)=1.0 ! endif ! enddo ! enddo ! enddo !zjmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm ENDIF C CALL DSTRB(TEMPSOIL,SMC,NSOIL,NSOIL,NSOIL) cpj CALL DSTRB(TEMPSOIL,SH2O,NSOIL,NSOIL,NSOIL) C---------------------------------------------------------------------- C*** C*** C*** DISTRIBUTE CMC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ CMC' ENDIF C CALL DSTRB(TEMP1,CMC,1,1,1) C---------------------------------------------------------------------- C*** C*** DISTRIBUTE STC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMPSOIL c WRITE(0,*)'READ STC' ENDIF C CALL DSTRB(TEMPSOIL,STC,NSOIL,NSOIL,NSOIL) !zjvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! do k=1,4 ! do j=myjs,myje ! do i=myis,myie !zj if(fis(i,j).gt.24000.) then ! stc(i,j,k)=stc(i,j,k)-0.00063*fis(i,j)-20. !*(fis(i,j)-24000.) !zj endif ! enddo ! enddo ! enddo !zjmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm C---------------------------------------------------------------------- C*** C*** DISTRIBUTE SH2O C*** c IF(MYPE.EQ.0)THEN c READ(NFCST)TEMPSOIL c WRITE(0,*)'READ SH2O' c ENDIF C c CALL DSTRB(TEMPSOIL,SH2O,NSOIL,NSOIL,NSOIL) !zjtest IF(MYPE.EQ.0)THEN !zjtest READ(83)TEMPSOIL !zjtest WRITE(0,*)'READ SH2O' !zjtest ENDIF !zjtest! !zjtest CALL DSTRB(TEMPSOIL,SH2O,NSOIL,NSOIL,NSOIL) C---------------------------------------------------------------------- C---------------------------------------------------------------------- C*** C*** C*** DISTRIBUTE ALBEDO C*** cpj c IF(MYPE.EQ.0)THEN c READ(NFCST)TEMP1 c WRITE(0,*)'READ ALBEDO' c ENDIF C c CALL DSTRB(TEMP1,ALBEDO,1,1,1) C---------------------------------------------------------------------- c stop C IYR =IDAT(3)-1900 IMNTH=IDAT(1) IDAY =IDAT(2) IF(MYPE.EQ.0)WRITE(LIST,*)'INIT: READ COLD START 1 INITIAL CONDITION FILE ENDED' C------------------------------------------------------------------- C------------------------------------------------------------------- C C SECOND, THE RESTART FILE CASE. C C------------------------------------------------------------------- C------------------------------------------------------------------- ELSE IF(MYPE.EQ.0)WRITE(LIST,*)'INIT: READ RESTART FILE' IF(MYPE.EQ.0)THEN READ(NFCST)RUN,IDAT,IHRST,NTSD,LABEL !!!!!! NTSD=MAX(NTSD-1,0) NTSD=MAX(NTSD,0) READ(NFCST)PDOMG,RESOMG ENDIF C 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) c CALL MPI_BCAST(LABEL,1,MPI_CHARACTER,0,MPI_COMM_COMP,IRTN) c CALL MPI_BCAST(PDOMG,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) c CALL MPI_BCAST(RESOMG,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) C C------------------------------------------------------------------- C*** C*** DISTRIBUTE OMGALF C*** DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ OMGALF' ENDIF CALL DSTRB(TEMP1,OMGALF,1,LM,L) ENDDO C------------------------------------------------------------------- C IF(MYPE.EQ.0)WRITE(LIST,*)' READ ',LABEL C IF(MYPE.EQ.0)THEN READ(NFCST)RUN,IDAT,IHRST,NTSD,LABEL,FIRST,IOUT,NSHDE !!!!!! NTSD=MAX(NTSD-1,0) NTSD=MAX(NTSD,0) ENDIF C FIRST=.TRUE. IF(NTSD.GT.0)FIRST=.FALSE. C 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) c CALL MPI_BCAST(LABEL,1,MPI_CHARACTER,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) C------------------------------------------------------------------- IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3 c WRITE(0,*)'READ PD' ENDIF C CALL DSTRB(TEMP1,PD,1,1,1) CALL DSTRB(TEMP2,RES,1,1,1) CALL DSTRB(TEMP3,FIS,1,1,1) C------------------------------------------------------------------- C*** LBM2=LB*LM*2 IF(MYPE.EQ.0)THEN IF(NINT(TSTART).EQ.0)THEN c READ(NFCST)PDB,TB,QB,UB,VB,(S8B,m=1, IDSTP) READ(NFCST)PDB,TB,QB,UB,VB,S8B print *," procitao s8b... ",idstp ELSE c READ(NFCST)PDB,TB,QB,UB,VB,Q2B,CWMB write(*,*) "read nfct pazi" READ(NFCST)PDB,TB,QB,UB,VB,Q2B,CWMB,S8B ENDIF ENDIF C 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) do k1=1, KPS CALL MPI_BCAST(S8B(1,1,1,k1),LBM2,MPI_REAL,0,MPI_COMM_COMP,IRTN) enddo 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) C IF(NINT(TSTART).GT.0)THEN CALL MPI_BCAST(Q2B(1,1,1),LBM2,MPI_REAL,0,MPI_COMM_COMP 1, IRTN) write(6,*) "read - bdcst " CALL MPI_BCAST(CWMB(1,1,1),LBM2,MPI_REAL,0,MPI_COMM_COMP 1, IRTN) c CALL MPI_BCAST(S8B (1,1,1),LBM2,MPI_REAL,0,MPI_COMM_COMP c 1, IRTN) ENDIF C------------------------------------------------------------------- C*** C*** PRIMARY 3-D VARIABLES C*** DO 300 L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! T(I,J,L) READ(NFCST)TEMP2 ! Q(I,J,L) READ(NFCST)TEMP3 ! U(I,J,L) READ(NFCST)TEMP4 ! V(I,J,L) READ(NFCST)TEMP5 ! Q2(I,J,L) ENDIF C CALL DSTRB(TEMP1,T,1,LM,L) CALL DSTRB(TEMP2,Q,1,LM,L) CALL DSTRB(TEMP3,U,1,LM,L) CALL DSTRB(TEMP4,V,1,LM,L) CALL DSTRB(TEMP5,Q2,1,LM,L) C C DUMMY READ OF THE TOTAL RADIATIVE TEMPERATURE TENDENCIES C WHICH ARE NOT USED EXPLICITLY IN THE INTEGRATION C IF(MYPE.EQ.0)THEN READ(NFCST) C write(*,*)" read nfct :cwm" READ(NFCST)((TEMP6(I,J),I=1,IM),J=1,JM) ! CWM(I,J,L) READ(NFCST)((TEMP7(I,J),I=1,IM),J=1,JM) ! TRAIN(I,J,L) READ(NFCST)((TEMP8(I,J),I=1,IM),J=1,JM) ! TCUCN(I,J,L) C ENDIF C write(*,*)" read 3 :cwm" CALL DSTRB(TEMP6,CWM,1,LM,L) CALL DSTRB(TEMP7,TRAIN,1,LM,L) CALL DSTRB(TEMP8,TCUCN,1,LM,L) C 300 CONTINUE C------------------------------------------------------------------- C IF(MYPE.EQ.0)WRITE(LIST,*)' READ ',LABEL C IF(MYPE.EQ.0)THEN READ(NFCST)RUN,IDAT,IHRST,NTSD,LABEL 1, TEMP1,TEMP2,TEMP3 2, TEMP4,((TEMP5(I,J),I=1,IM),J=1,JM),TEMP6 !!!!! NTSD=MAX(NTSD-1,0) NTSD=MAX(NTSD,0) ENDIF C CALL DSTRB(TEMP1,RSWIN,1,1,1) CALL DSTRB(TEMP2,RSWOUT,1,1,1) CALL DSTRB(TEMP3,TG,1,1,1) C IF(NTSD.GT.0)THEN CALL DSTRB(TEMP4,Z0,1,1,1) ENDIF C CALL DSTRB(TEMP5,AKMS,1,1,1) CALL DSTRB(TEMP6,CZEN,1,1,1) C 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) c CALL MPI_BCAST(LABEL,1,MPI_CHARACTER,0,MPI_COMM_COMP,IRTN) C C------------------------------------------------------------------- IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7 ENDIF C CALL DSTRB(TEMP1,AKHS,1,1,1) CALL DSTRB(TEMP2,THS,1,1,1) CALL DSTRB(TEMP3,QS,1,1,1) CALL DSTRB(TEMP4,TWBS,1,1,1) CALL DSTRB(TEMP5,QWBS,1,1,1) CALL DSTRB(TEMP6,HBOT,1,1,1) CALL DSTRB(TEMP7,CFRACL,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2 1, ((TEMP3(I,J),I=1,IM),J=1,JM) 2, ((TEMP4(I,J),I=1,IM),J=1,JM) 3, TEMP5,TEMP6,TEMP7 ENDIF C CALL DSTRB(TEMP1,THZ0,1,1,1) CALL DSTRB(TEMP2,QZ0,1,1,1) CALL DSTRB(TEMP3,UZ0,1,1,1) CALL DSTRB(TEMP4,VZ0,1,1,1) CALL DSTRB(TEMP5,USTAR,1,1,1) CALL DSTRB(TEMP6,HTOP,1,1,1) CALL DSTRB(TEMP7,CFRACM,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7 ENDIF C CALL DSTRB(TEMP1,SNO,1,1,1) call dstrb(temp2,si,1,1,1) CALL DSTRB(TEMP3,CLDEFI,1,1,1) CALL DSTRB(TEMP4,RF,1,1,1) CALL DSTRB(TEMP5,PSLP,1,1,1) CALL DSTRB(TEMP6,CUPPT,1,1,1) CALL DSTRB(TEMP7,CFRACH,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6 ENDIF C CALL DSTRB(TEMP1,SOILTB,1,1,1) CALL DSTRB(TEMP2,SFCEXC,1,1,1) CALL DSTRB(TEMP3,SMSTAV,1,1,1) CALL DSTRB(TEMP4,SMSTOT,1,1,1) CALL DSTRB(TEMP5,GRNFLX,1,1,1) CALL DSTRB(TEMP6,PCTSNO,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 1, ((TEMP2(I,J),I=1,IM),J=1,JM) 2, TEMP3,TEMP4 ENDIF C CALL DSTRB(TEMP1,RLWIN,1,1,1) CALL DSTRB(TEMP2,RADOT,1,1,1) CALL DSTRB(TEMP3,CZMEAN,1,1,1) CALL DSTRB(TEMP4,SIGT4,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,UL,ITEMP,TEMP3 ENDIF C CALL DSTRB(TEMP1,U00,1,1,1) CALL IDSTRB(ITEMP,LC) CALL DSTRB(TEMP3,SR,1,1,1) CALL MPI_BCAST(UL(1),2*LM,MPI_REAL,0,MPI_COMM_COMP,IRTN) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)RUN,IDAT,IHRST,NTSD,LABEL 1, TEMP1,TEMP2,TEMP3,TEMP4 !!!!!! NTSD=MAX(NTSD-1,0) NTSD=MAX(NTSD,0) ENDIF C CALL DSTRB(TEMP1,PREC,1,1,1) CALL DSTRB(TEMP2,ACPREC,1,1,1) CALL DSTRB(TEMP3,ACCLIQ,1,1,1) CALL DSTRB(TEMP4,CUPREC,1,1,1) 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) c CALL MPI_BCAST(LABEL,1,MPI_CHARACTER,0,MPI_COMM_COMP,IRTN) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,ITEMP,TEMP3,ITEMP2 ENDIF C CALL DSTRB(TEMP1,ACFRCV,1,1,1) CALL IDSTRB(ITEMP,NCFRCV) CALL DSTRB(TEMP3,ACFRST,1,1,1) CALL IDSTRB(ITEMP2,NCFRST) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4 ENDIF C CALL DSTRB(TEMP1,ACSNOW,1,1,1) CALL DSTRB(TEMP2,ACSNOM,1,1,1) CALL DSTRB(TEMP3,SSROFF,1,1,1) CALL DSTRB(TEMP4,BGROFF,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6 1, TEMP7 ENDIF C CALL DSTRB(TEMP1,SFCSHX,1,1,1) CALL DSTRB(TEMP2,SFCLHX,1,1,1) CALL DSTRB(TEMP3,SUBSHX,1,1,1) CALL DSTRB(TEMP4,SNOPCX,1,1,1) CALL DSTRB(TEMP5,SFCUVX,1,1,1) CALL DSTRB(TEMP6,SFCEVP,1,1,1) CALL DSTRB(TEMP7,POTEVP,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6 ENDIF C CALL DSTRB(TEMP1,ASWIN,1,1,1) CALL DSTRB(TEMP2,ASWOUT,1,1,1) CALL DSTRB(TEMP3,ASWTOA,1,1,1) CALL DSTRB(TEMP4,ALWIN,1,1,1) CALL DSTRB(TEMP5,ALWOUT,1,1,1) CALL DSTRB(TEMP6,ALWTOA,1,1,1) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)ARDSW,ARDLW,ASRFC,AVRAIN,AVCNVC ENDIF C CALL MPI_BCAST(ARDSW,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ARDLW,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ASRFC,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(AVRAIN,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(AVCNVC,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) C CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) C------------------------------------------------------------------- C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3,TEMP4,TEMP5,TEMP6,TEMP7 ENDIF C CALL DSTRB(TEMP1,TH10,1,1,1) CALL DSTRB(TEMP2,Q10,1,1,1) CALL DSTRB(TEMP3,U10,1,1,1) CALL DSTRB(TEMP4,V10,1,1,1) CALL DSTRB(TEMP5,TSHLTR,1,1,1) CALL DSTRB(TEMP6,QSHLTR,1,1,1) CALL DSTRB(TEMP7,PSHLTR,1,1,1) C------------------------------------------------------------------- C*** C*** DISTRIBUTE SMC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMPSOIL ENDIF C CALL DSTRB(TEMPSOIL,SMC,NSOIL,NSOIL,NSOIL) czjvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv c do k=1,4 c do j=myjs,myje c do i=myis,myie c if(fis(i,j).gt.20000.) then c smc(i,j,k)=0.5 !zjtest c endif c enddo c enddo c enddo czjmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm C------------------------------------------------------------------- C*** C*** DISTRIBUTE CMC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ENDIF C CALL DSTRB(TEMP1,CMC,1,1,1) C------------------------------------------------------------------- C*** C*** DISTRIBUTE STC C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMPSOIL ENDIF C CALL DSTRB(TEMPSOIL,STC,NSOIL,NSOIL,NSOIL) !zjvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !zj do k=1,4 !zj do j=myjs,myje !zj do i=myis,myie !zj if(fis(i,j).gt.20000.) then !zj stc(i,j,k)=stc(i,j,k)-0.00063*(fis(i,j)-20000.) !zj endif !zj enddo !zj enddo !zj enddo !zjmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm C C---------------------------------------------------------------------- C*** C*** DISTRIBUTE SH2O C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMPSOIL c WRITE(0,*)'READ SH2O' ENDIF C CALL DSTRB(TEMPSOIL,SH2O,NSOIL,NSOIL,NSOIL) C------------------------------------------------------------------- C*** C*** DISTRIBUTE ALBEDO C*** IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 c WRITE(0,*)'READ ALBEDO' ENDIF C CALL DSTRB(TEMP1,ALBEDO,1,1,1) C---------------------------------------------------------------------- IF(NINT(TSTART).NE.0)THEN C*** C*** DISTRIBUTE HYDROMETEOR FRACTIONS C*** DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)((TEMP1(I,J),I=1,IM),J=1,JM) c WRITE(0,*)'READ F_ice' ENDIF C CALL DSTRB(TEMP1,DUM,1,LM,L) ENDDO C CALL SGETMO(DUM,NHRZ,NHRZ,LM,F_ice,LM) C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)((TEMP1(I,J),I=1,IM),J=1,JM) c WRITE(0,*)'READ F_rain' ENDIF C CALL DSTRB(TEMP1,DUM,1,LM,L) ENDDO C CALL SGETMO(DUM,NHRZ,NHRZ,LM,F_rain,LM) C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)((TEMP1(I,J),I=1,IM),J=1,JM) c WRITE(0,*)'READ F_RimeF' ENDIF C CALL DSTRB(TEMP1,DUM,1,LM,L) ENDDO C CALL SGETMO(DUM,NHRZ,NHRZ,LM,F_RimeF,LM) C ENDIF C---------------------------------------------------------------------- C*** C*** IF FORECAST IS NOT BEGINNING AT TIME 0 C*** THEN WE MUST READ ADDITIONAL INFORMATION C*** IF(NINT(TSTART).NE.0)THEN C IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1,TEMP2,TEMP3 1, ACUTIM,ARATIM,APHTIM ENDIF CALL DSTRB(TEMP1,POTFLX,1,1,1) CALL DSTRB(TEMP2,TLMIN,1,1,1) CALL DSTRB(TEMP3,TLMAX,1,1,1) CALL MPI_BCAST(ACUTIM,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ARATIM,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(APHTIM,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! RSWTT READ(NFCST)TEMP2 ! RLWTT ENDIF C CALL DSTRB(TEMP1,RSWTT,1,LM,L) CALL DSTRB(TEMP2,RLWTT,1,LM,L) ENDDO C IF(MYPE.EQ.0)THEN READ(NFCST)TEMP2 ! CNVBOT READ(NFCST)TEMP3 ! CNVTOP READ(NFCST)TEMP4 ! RSWTOA READ(NFCST)TEMP5 ! RLWTOA ENDIF C CALL DSTRB(TEMP2,CNVBOT,1,1,1) CALL DSTRB(TEMP3,CNVTOP,1,1,1) CALL DSTRB(TEMP4,RSWTOA,1,1,1) CALL DSTRB(TEMP5,RLWTOA,1,1,1) C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! DWDT ENDIF C CALL DSTRB(TEMP1,DWDT,1,LM,L) ENDDO C DO L=1,LM+1 IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! W READ(NFCST)TEMP2 ! PINT ENDIF C CALL DSTRB(TEMP1,W,1,LM+1,L) CALL DSTRB(TEMP2,PINT,1,LM+1,L) ENDDO C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! TOLD READ(NFCST)TEMP2 ! UOLD READ(NFCST)TEMP3 ! VOLD ENDIF C CALL DSTRB(TEMP1,TOLD,1,LM,L) CALL DSTRB(TEMP2,UOLD,1,LM,L) CALL DSTRB(TEMP3,VOLD,1,LM,L) ENDDO C DO L=1,LM IF(MYPE.EQ.0)THEN READ(NFCST)TEMP1 ! T_adj ENDIF C CALL DSTRB(TEMP1,T_adj,1,LM,L) ENDDO C ENDIF C------------------------------------------------------------------- C c IF(MYPE.EQ.0)WRITE(LIST,*)' READ ',LABEL C C------------------------------------------------------------------- C*** CALL RADIATION TO OBTAIN THE SHORT AND LONGWAVE C*** TEMPERATURE TENDENCIES C*** C c CALL RADTN C ENDIF C C DONE READING INITIAL CONDITIONS OR A RESTART FILE. C C C END OF SUBROUTINE READ_RESTRT C IF(MYPE.EQ.0)THEN WRITE(LIST,*)'INIT: EXIT READ_RESTRT' WRITE(LIST,*)' ' ENDIF C RETURN END