!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE NEWFLT !----------------------------------------------------------------- INCLUDE "EXCHM.h" INCLUDE "parmeta.f90" INCLUDE "parm.tbl.f90" INCLUDE "mpp.h" INCLUDE "mpif.h" #include "sp.h" !----------------------------------------------------------------------- PARAMETER & (PIQ=3.141592654,LP1=LM+1,JAM=6+2*(JM-10),LB=2*IM+JM-3) !----------------------------------------------------------------------- ! NTIM IS A SPAN IN TIME STEP UNITS FOR THE BACKWARD INTEGRATION PARAMETER & (NTIM=270) PARAMETER & (CM1=2937.4,CM2=4.9283,CM3=23.5518,EPS=0.622) integer :: divhoa_status, pdte_status,vtadvf_status, pgcor_status,& hzadv_status !----------------------------------------------------------------------- LOGICAL :: & RUN,FIRST,RESTRT,SIGMA !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_DYNAM.f90" !----------------------------------------------------------------------- INCLUDE "COMM_CONTIN.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_PVRBLS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_CLDWTR.f90" !----------------------------------------------------------------------- INCLUDE "COMM_BOCO.f90" !----------------------------------------------------------------------- DATA KNT/0/,IUNRH/51/,IUNDF/52/ !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& !----------------------------------------------------------------------- NBOCO=0 !*** !*** SMOOTH THE INITIAL TEMPERATURE FIELD BEFORE EXECUTING !*** THE FILTER ! CALL FILT25(T(IDIM1,JDIM1,L),HTM(IDIM1,JDIM1,L),5) SPAN=FLOAT(NTIM)*DT/3600. IF(MYPE == 0)WRITE(6,100)SPAN 100 FORMAT(' ','INITIALIZATION CALLED WITH SPAN',F5.1,' HOURS') !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** RUN THE MODEL BACKWARD THEN FORWARD !----------------------------------------------------------------------- ! ADIABATIC BACKWARD INTEGRATION, STARTING FROM THE INITIAL TIME !----------------------------------------------------------------------- !*** CHANGE (SIGN ONLY OF) IMPORTANT TIME CONSTANTS DT =-DT CPGFV=-CPGFV EN =-EN ENT =-ENT F4D =-F4D F4Q =-F4Q EF4T =-EF4T DO JK=1,JAM EM (JK)=-EM (JK) EMT(JK)=-EMT(JK) ENDDO DO L=1,LM F4Q2(L)=-F4Q2(L) ENDDO DO J=MYJS,MYJE DO I=MYIS,MYIE WPDAR(I,J)=-WPDAR(I,J) CPGFU(I,J)=-CPGFU(I,J) CURV (I,J)=-CURV (I,J) FCP (I,J)=-FCP (I,J) FAD (I,J)=-FAD (I,J) F (I,J)=-F (I,J) ENDDO ENDDO !-------------------------------------------------------------------- NTSD=0 FIRST= .TRUE. TSPH=-3600./DT !----------------------------------------------------------------------- !********ENTRY INTO THE TIME LOOP*************************************** 2020 NTSD=NTSD+1 KNT=KNT+1 IF(MYPE == 0)WRITE(6,2015)NTSD,NTIM !*********************************************************************** !*** DIVERGENCE AND HORIZONTAL PART OF THE OMEGA-ALPHA TERM IF(NTSD > 1)CALL EXCH(T,LM,U,LM,V,LM,2,2) !Exchange T, U, and V CALL DIVHOA call exit(divhoa_status) !----------------------------------------------------------------------- !*** PRESS. TEND.,ETA DOT & VERTICAL OMEGA-ALPHA CALL PDTE call exit(pdte_status) !----------------------------------------------------------------------- !*** VERTICAL ADVECTION IF(MOD(NTSD-1,IDTAD) == 0)THEN CALL EXCH(ETADT,LM-1,1,1) CALL VTADVF call exit(vtadvf_status) CALL EXCH(T,LM,U,LM,V,LM,Q2,LM,1,1) !Exchange T, U, and V ENDIF !----------------------------------------------------------------------- !*** UPDATE SURFACE PRESSURE (MINUS PTOP) CALL PDNEW !----------------------------------------------------------------------- !*** UPDATE H BOUNDARY POINTS IF(MOD(NTSD,IDTAD) == 0)THEN CALL EXCH(T,LM,Q2,LM,1,1) ENDIF CALL EXCH(PD,1,1,1) CALL BOCOHF !----------------------------------------------------------------------- !*** PRESSURE GRADIENT AND CORIOLIS FORCE TERMS CALL EXCH(PD,1,T,LM,2,2) !Exchange PD and T CALL PGCOR call exit(pgcor_status) CALL EXCH(PDSL,1,5,5) !----------------------------------------------------------------------- !*** UPDATE V BOUNDARY POINTS CALL EXCH(U,LM,V,LM,1,1) !Exchange U and V CALL BOCOV !----------------------------------------------------------------------- !*** HORIZONTAL ADVECTION IF(MOD(NTSD,IDTAD) == 0)THEN CALL EXCH(T,LM,U,LM,V,LM,4,4) !Exchange T, U, and V CALL EXCH(Q2,LM,5,5) CALL HZADV call exit(hzadv_status) CALL EXCH(U,LM,V,LM,2,2) !Exchange U and V ENDIF !----------------------------------------------------------------------- IF(NTSD == NTIM) GO TO 2022 !*********************************************************************** GO TO 2020 !********EXIT FROM THE TIME LOOP**************************************** 2022 CONTINUE !----------------------------------------------------------------------- !*** READY FOR FORWARD INTEGRATION !----------------------------------------------------------------------- NTSD=0 FIRST= .TRUE. TSPH=-3600./DT IF(MYPE == 0)THEN REWIND NBC READ(NBC) READ(NBC)BCHR READ(NBC)PDB READ(NBC)TB READ(NBC)QB READ(NBC)UB READ(NBC)VB READ(NBC)Q2B READ(NBC)CWMB ENDIF CALL MPI_BCAST(BCHR,1,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(PDB(1,1),2*LB,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(TB(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(QB(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(UB(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VB(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(Q2B(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BCAST(CWMB(1,1,1),2*LB*LM,MPI_REAL,0, & MPI_COMM_COMP,IRTN) CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) IF(MYPE == 0)WRITE(LIST,*)' READ UNIT NBC=',NBC !*** !*** COMPUTE THE 1ST TIME FOR BOUNDARY CONDITION READ !*** NBOCO=INT(BCHR*TSPH+0.5) if(mype == 0)write(6,*)' nboco=',nboco IF(NTSD == NBOCO)THEN IF(MYPE == 0)THEN BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC BACKSPACE NBC WRITE(LIST,*)' BACKSPACE UNIT NBC=',NBC ENDIF ENDIF !*** CHANGE BACK (SIGN ONLY) IMPORTANT TIME CONSTANTS DT =-DT CPGFV=-CPGFV EN =-EN ENT =-ENT F4D =-F4D F4Q =-F4Q EF4T =-EF4T DO JK=1,JAM EM (JK)=-EM (JK) EMT(JK)=-EMT(JK) ENDDO DO L=1,LM F4Q2(L)=-F4Q2(L) ENDDO DO J=MYJS,MYJE DO I=MYIS,MYIE WPDAR(I,J)=-WPDAR(I,J) CPGFU(I,J)=-CPGFU(I,J) CURV (I,J)=-CURV (I,J) FCP (I,J)=-FCP (I,J) FAD (I,J)=-FAD (I,J) F (I,J)=-F (I,J) ENDDO ENDDO !-------------------------------------------------------------------- !*** INTEGRATE FORWARD WITH FULL PHYSICS !-------------------------------------------------------------------- NTSD=0 !----------------------------------------------------------------------- !********ENTRY INTO THE TIME LOOP*************************************** 2010 NTSD=NTSD+1 KNT=KNT+1 IF(MYPE == 0)WRITE(6,2015)NTSD,NTIM 2015 FORMAT(' NTSD=',I5,' NTSTM=',I4) !----------------------------------------------------------------------- !------------------------RADIATION-------------------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD-1,NRADS) == 0 .OR. MOD(NTSD-1,NRADL) == 0)THEN CALL RADTN ENDIF !*********************************************************************** !*** DIVERGENCE AND HORIZONTAL PART OF THE OMEGA-ALPHA TERM IF(NTSD > 1)CALL EXCH(T,LM,U,LM,V,LM,2,2) !Exchange T, U, and V CALL DIVHOA !----------------------------------------------------------------------- !*** PRESS. TEND.,ETA DOT & VERTICAL OMEGA-ALPHA CALL PDTE !----------------------------------------------------------------------- !*** VERTICAL ADVECTION IF(MOD(NTSD-1,IDTAD) == 0)THEN CALL EXCH(ETADT,LM-1,1,1) CALL VTADV CALL EXCH(T,LM,U,LM,V,LM,Q2,LM,1,1) !Exchange T, U, and V ENDIF !----------------------------------------------------------------------- !*** UPDATE SURFACE PRESSURE (MINUS PTOP) CALL PDNEW !----------------------------------------------------------------------- !*** UPDATE H BOUNDARY POINTS IF(MOD(NTSD,IDTAD) == 0)THEN CALL EXCH(T,LM,Q,LM,Q2,LM,1,1) ENDIF CALL EXCH(PD,1,1,1) call mpi_barrier(MPI_COMM_COMP,istat) CALL EXCH(CWM,LM,1,1) CALL BOCOH !----------------------------------------------------------------------- !*** PRESSURE GRADIENT AND CORIOLIS FORCE TERMS CALL EXCH(PD,1,T,LM,Q,LM,2,2) !Exchange PD and T CALL PGCOR CALL EXCH(PDSL,1,5,5) !----------------------------------------------------------------------- !--------DIVERGENCE DAMPING--------------------------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD,NTDDMP) == 0)THEN CALL EXCH(T,LM,U,LM,V,LM,DIV,LM,1,1) !Exchange T, U, and V CALL DDAMP ENDIF !----------------------------------------------------------------------- !*** UPDATE V BOUNDARY POINTS CALL EXCH(U,LM,V,LM,1,1) !Exchange U and V CALL BOCOV !----------------------------------------------------------------------- !--------APPLY TEMPERATURE TENDENCY DUE TO RADIATION-------------------- !----------------------------------------------------------------------- CALL RDTEMP !----------------------------------------------------------------------- !--------LATERAL DIFFUSION---------------------------------------------- !----------------------------------------------------------------------- CALL EXCH(T,LM,U,LM,V,LM,Q,LM,2,2) !Exchange T, U, V, and Q CALL EXCH(Q2,LM,1,1) CALL HDIFF !----------------------------------------------------------------------- !*** HORIZONTAL ADVECTION IF(MOD(NTSD,IDTAD) == 0)THEN CALL EXCH(T,LM,U,LM,V,LM,4,4) !Exchange T, U, and V CALL EXCH(Q2,LM,5,5) CALL HZADV CALL EXCH(U,LM,V,LM,CWM,LM,2,2) !Exchange U and V CALL HZADV2 ENDIF !----------------------------------------------------------------------- !--------TURBULENT PROCESSES AND PRECIPITATION-------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD-NPHS/2,NPHS) == 0)THEN CALL EXCH(PD,1,UZ0,1,VZ0,1,T,LM,U,LM,V,LM,Q,LM,1,1) !Exchange PD, T, U, V, and Q CALL TURBL !Contains calls to EXCH ENDIF !----------------------------------------------------------------------- !--------CONDENSATION/EVAPORATION OF CLOUD WATER------------------------ !----------------------------------------------------------------------- IF(MOD(NTSD-NPHS/2,NPHS) == 0)THEN CALL GSCOND ENDIF !----------------------------------------------------------------------- !--------CONVECTIVE PRECIPITATION--------------------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD-NCNVC/2,NCNVC) == 0)THEN CALL CUCNVC ENDIF !----------------------------------------------------------------------- !--------GRIDSCALE PRECIPITATION---------------------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD-NPHS/2,NPHS) == 0)THEN CALL PRECPD ENDIF !----------------------------------------------------------------------- IF(NTSD == NTIM) GO TO 2013 !*********************************************************************** GO TO 2010 !********EXIT FROM THE TIME LOOP**************************************** 2013 CONTINUE CALL MPI_BARRIER(MPI_COMM_COMP,IRTN) !----------------------------------------------------------------------- ! RETURN BC FILE TO START FORECAST NTSD=0 IF(MYPE == 0)THEN REWIND NBC READ(NBC) READ(NBC)BCHR ENDIF CALL MPI_BCAST(BCHR,1,MPI_REAL,0,MPI_COMM_COMP,IRTN) NBOCO=INT(BCHR*TSPH+0.5) !------------------- END OF CHANGE ------------------------- !----------------------------------------------------------- RETURN END SUBROUTINE NEWFLT