PROGRAM EBU !$$$ MAIN PROGRAM DOCUMENTATION BLOCK ! . . . . ! MAIN PROGRAM: ETAFCST EARLY ETA MODEL FORECAST DRIVER ! PRGMMR: JANJIC ORG: NP22 DATE: 99-01-20 ! ABSTRACT: EBU3 CONTAINS THE PRIMARY RUNSTREAM FOR THE EARLY ETA ! FORECAST MODEL. AFTER AN INITIAL CALL TO SUBROUTINE INIT, CALLS ! ARE MADE TO SUBROUTINES WHICH COMPUTE THE VARIOUS DYNAMICAL AND ! PHYSICAL PROCESSES IN THE MODEL. THE VARIABLE 'NTSD' IS THE ! FUNDAMENTAL TIMESTEP COUNTER AND THUS ITS VALUE DETERMINES WHEN ! THE SUBROUTINES ARE CALLED. INFORMATION PERTAINING TO THE SCHEMES ! USED IN THE MODEL AS WELL AS ADDITIONAL REFERENCES MAY BE FOUND ! IN "THE STEP-MOUNTAIN ETA COORDINATE REGIONAL MODEL: A DOCUMEN-" ! TATION" (BLACK 1988; DEVELOPMENT DIVISION) AND "THE NEW NMC MESO- ! SCALE ETA MODEL: DESCRIPTION AND FORECAST EXAMPLES (BLACK 1994; ! WEATHER AND FORECASTING). ! PROGRAM HISTORY LOG: ! 87-08-?? JANJIC, ORIGINATOR ! BLACK ! 93-05-12 TREADON DOCBLOCK INSERTED ! 93-10-25 BLACK DOCBLOCK UPDATED ! 97-03-15 MESINGER SPLITTING MODIFIED, TO SEPARATE THE ! ADJUSTMENT AND THE ADVECTION STEP ! 97-11-19 BLACK MODIFIED FOR DISTRIBUTED MEMORY ! 98-10-20 BLACK DISTRIBUTED MEMORY FORM FOR ! CURRENT OPERATIONAL CODE ! 00-02-25 TUCCILLO INCORPORATED ASYNCHRONOUS I/O SERVERS ! 00-11-14 BLACK INCORPORATED JANJIC NONHYDROSTATIC OPTION ! 00-11-27 BLACK INCORPORATED RESTART CAPABILITY ! USAGE: MAIN PROGRAM ! INPUT FILES: NONE (SEE SUBROUTINE INIT) ! OUTPUT FILES: NONE (SEE SUBROUTINE CHKOUT) ! SUBPROGRAMS CALLED: ! UNIQUE: ! INIT - INITIALIZE VARIABLES AT START OF INTEGRATION ! DIVHOA - DIVERGENCE, AND HORIZONTAL PART OF THE OMEGA-ALPHA ! TERM ! PGCOR - PRESSURE GRADIENT AND CORIOLIS FORCE ! PDTE - UPDATE SURFACE PRESSURE TENDENCY AND ETADOT ! VTADV - VERTICAL ADVECTION ! HZADV - HORIZONTAL ADVECTION OF T,U,V, AND TKE ! HZADV2 - HORIZONTAL ADVECTION OF Q AND CLOUD WATER ! DDAMP - APPLY DIVERGENCE DAMPING ! PDNEW - UPDATE SURFACE PRESSURE ! HDIFF - LATERAL DIFFUSION ! BOCOH - UPDATE H POINTS ON THE BOUNDARIES ! BOCOV - UPDATE V POINTS ON THE BOUNDARIES ! RADTN - RADIATION DRIVER ! RDTEMP - APPLY TEMPERATURE TENDENCY DUE TO RADIATION ! TURBL - PERFORM THE VERTICAL TURBULENT EXCHANGE ! SURFACE - UPDATE SURFACE TEMPERATURE, MOISTURE, AND OTHER ! GROUND HYDROLOGY ! GSCOND - CLOUD WATER/ICE PHYSICS PARAMETERIZATION (EDAS only) ! CUCNVC - CONVECTIVE ADJUSTMENT FOR DEEP OR SHALLOW CONVECTION ! PRECPD - GRID SCALE PRECIPITATION (EDAS only) ! GSMDRIVE - GRID SCALE MICROPHYSICS DRIVER (free forecast only) ! ADJPPT - adjust model precipitation to observations ! CLTEND - UPDATE TEMPERATURE FROM (GRID- AND SUBGRID-SCALE) CLOUD PROCESSES ! CHKOUT - POST PROFILE DATA. FOR INTERNAL POST, ! POSTS MODEL OUTPUT. FOR EXTERNAL POST, ! WRITES TEMPORARY FILE CONTAINING ALL MODEL ! ARRAYS. ! EXIT STATES: ! COND = 1 - NORMAL EXIT ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ ! ****************************************************************** ! * * ! * LIMITED AREA ETA MODEL * ! * WITH STEP-MOUNTAIN TOPOGRAPHY * ! * * ! * * ! * NOAA / NATIONAL CENTERS FOR ENVIRONMENTAL PREDICTION, * ! * CAMP SPRINGS, MD * ! * * ! * GEOPHYSICAL FLUID DYNAMICS LABORATORY / NOAA, PRINCETON, NJ, * ! * * ! * UNIVERSITY CORPORATION FOR ATMOSPHERIC RESEARCH, BOULDER, CO, * ! * & * ! * DEPARTMENT OF METEOROLOGY, UNIVERSITY OF BELGRADE, YUGOSLAVIA * ! * * ! ****************************************************************** ! ****************************************************************** ! * * ! * REFERENCES * ! * FOR THE DYNAMICAL PART OF THE MODEL * ! * * ! * STEP-MOUNTAIN ETA COORDINATE: * ! * F. MESINGER, 1983, IN RES. ACTIVITIES IN ATMOS. AND * ! * OCEANIC MODELING, REP. NO. 5, WMO, GENEVA, 4.9-4.10. * ! * * ! * HORIZONTAL ADVECTION, CONTINUITY EQUATION: * ! * Z.I. JANJIC, 1984, MWR, 112, NO.6, 1234-1245. * ! * * ! * INTERNAL BOUNDARIES, OMEGA-ALPHA TERM, CODING, PERFORMANCE: * ! * MESINGER ET AL., 1988, MWR, 116 NO.7, 1493-1518. * ! * * ! * N.B. FOR MORE DETAILS ON THESE TOPICS SEE ALSO: * ! * * ! * 1. MESINGER, F., AND Z.I. JANJIC, 1985: PROBLEMS AND * ! * NUMERICAL METHODS OF THE INCORPORATION OF MOUNTAINS IN * ! * ATMOSPHERIC MODELS. LECTURES IN APPLIED MATHEMATICS, * ! * VOL 22, AMER. MATH. SOC.; ALSO, NUMERICAL METHODS FOR * ! * WEATHER PREDICTION, SEMINAR 1983, ECMWF, 103-157; * ! * ALSO, SHORT- AND MEDIUM-RANGE WEATHER PREDICTION * ! * RESEARCH PUBL. SER., NO. 8, WMO, GENEVA, 175-233. * ! * * ! * 2. JANJIC, Z.I., AND F. MESINGER, 1983: FINITE-DIFFERENCE * ! * METHODS FOR THE SHALLOW WATER EQUATIONS ON VARIOUS * ! * HORIZONTAL GRIDS. NUMERICAL METHODS FOR WEATHER * ! * PREDICTION, SEMINAR 1983, ECMWF,29-101. * ! * * ! * SOME REFERENCES * ! * FOR THE PHYSICS PART OF THE MODEL * ! * * ! * JANJIC, Z.I., 1990: THE STEP-MOUNTAIN COORDINATE: * ! * PHYSICAL PACKAGE. MONTHLY WEATHER REVIEW, VOL. 118, * ! * NO. 7, 1429-1443. * ! * JANJIC, Z.I., 1994: THE STEP MOUNTAIN ETA COORDINATE: * ! * FURTHER DEVELOPMENTS OF THER CONVECTION, VISCOUS SUBLAYER, * ! * AND TURBULENCE CLOSURE SCHEMES. MONTHLY WEATHER REVIEW, * ! * VOL. 122, 927-945. * ! * * ! * ALSO SEE REFERENCES IN PHYSICAL SUBROUTINES * ! * * ! ****************************************************************** ! ****************************************************************** ! * * ! * THIS VERSION OF THE PROGRAM IS WRITTEN IN STANDARD ANSI * ! * FORTRAN 90 * ! * * ! * PRINCIPAL PROGRAMMERS: * ! * * ! * Z. JANJIC, UNIVERSITY OF BELGRADE, * ! * T. BLACK, NCEP ! * * ! ****************************************************************** ! * * ! * THE MODEL USES THE SEMI-STAGGERED E GRID IN ARAKAWA NOTATION. * ! * HORIZONTAL INDEXING IS TWO-DIMENSIONAL. ! * * ! * * ! * * ! * H(1,JM) V(1,JM) H(2,JM) V(2,JM) ...... V(IM-1,JM) H(IM,JM) * ! * . . . . . . * ! * . . . . . . * ! * . . . . . . * ! * . . . . . . * ! * * ! * H(1,3) V(1,3) H(2,3) V(2,3) ....... V(IM-1,3) H(IM,3) * ! * * ! * V(1,2) H(1,2) V(2,2) H(2,2) ....... H(IM-1,2) V(IM,2) * ! * * ! * H(1,1) V(1,1) H(2,1) V(2,1) ....... V(IM-1,1) H(IM,1) * ! * * ! * * ! * * ! * ARRAYS ARE DIMENSIONED (IM,JM). NOTE THAT A PHANTOM COLUMN * ! * OF POINTS MUST EXIST ALONG THE EASTERN EDGE FOR THE ARRAYS * ! * TO BE COMPLETE. * ! * * ! * THE TOTAL NUMBER OF GRID POINTS IN THE HORIZONTAL EXCLUDING * ! * THE PHANTOM COLUMN IS IMJM=IM*JM-JM/2. * ! * * ! * AUXILIARY ARRAYS ARE USED TO LOCATE NEIGHBORING GRID POINTS * ! * WITH RESPECT TO A GIVEN GRID POINT. IHE(J) IS THE INCREMENT * ! * TO THE I INDEX NEEDED TO REFER TO THE V POINT EAST OF AN * ! * H POINT THUS IHE(J)=0 ON ODD ROWS AND =1 ON EVEN ROWS. * ! * IHW(J)=IHE(J)-1 IS THE INCREMENT TO THE INDEX OF AN H POINT * ! * TO REFER TO THE V POINT TO THE WEST OF THAT H POINT. THE * ! * ANALOG EXISTS FOR THE ARRAYS IVE(J) AND IVW(J). * ! * * ! * BOUNDARY MASKS AND TOPOGRAPHY MASKS ARE DEFINED FOR VECTOR * ! * PROCESSING. THE BOUNDARY MASKS HBM2(K) AND VBM2(K) ARE * ! * EQUAL TO ONE EVERYWHERE EXCEPT AT THE TWO OUTERMOST ROWS * ! * WHERE THEY ARE EQUAL TO ZERO. THE BOUNDARY MASK VBM3(K) IS * ! * EQUAL TO ONE EVERYWHERE EXCEPT AT THE THREE OUTERMOST ROWS * ! * WHERE IT IS EQUAL TO ZERO. THE TOPOGRAPHY MASKS (HTM(K,L) * ! * AND VTM(K,L)) ARE SET TO ZERO UNDERNEATH THE TOPOGRAPHY AND * ! * TO ONE ELSWHERE. IN ADDITION, FOR TREATMENT OF PHYSICAL * ! * PROCESSES, MAXIMUM VALUES OF THE VERTICAL INDEX ARE DEFINED * ! * AND STORED (LMH(K) AND LMV(K). ! * * ! ****************************************************************** !************************************************************************************ ! THE NUMBER OF QUILT SERVERS MUST AGREE WITH THE FOLLOWING RELATIONSHIP: ! 0 <= NUMBER_QUILT_SERVERS <= JNPES ! WHERE THE NUMBER_QUILT_SERVERS = ( NUMBER_OF MPI_TASKS - INPES*JNPES ) ! PREFERABLY, THE NUMBER OF QUILT SERVERS DIVIDES EVENLY INTO JNPES ! Jim Tuccillo August 2000 !************************************************************************************ INCLUDE 'EXCHM.h' LOGICAL :: & RUN,FIRST,RESTRT,SIGMA,NEST, CLTEND_test !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpif.h" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" INCLUDE "COMM_CONTIN.f90" INCLUDE "COMM_VRBLS.f90" INCLUDE "COMM_PVRBLS.f90" INCLUDE "COMM_NHYDRO.f90" INCLUDE "COMM_CLDWTR.f90" INCLUDE "COMM_NSOILTYPE.f90" !----------------------------------------------------------------------- LOGICAL :: GSPREC NAMELIST /GSPRECNML/ GSPREC !----------------------------------------------------------------------- LOGICAL :: SLOPE NAMELIST /SLOPENML/ SLOPE !----------------------------------------------------------------------- !*** !*** THE FOLLOWING ARE USED FOR TIMIMG PURPOSES ONLY !*** real*8 :: timef real :: nhb_tim,mpp_tim,init_tim common/timing/surfce_tim,nhb_tim,res_tim,exch_tim ! L character envar*4, srfile*7 ! L !----------------------------------------------------------------------- !*** !*** INITIALIZE MPI, !*** SETUP I/O SERVER MECHANICS AND CHECK FOR WHETHER A !*** SUFFICIENT NUMBER OF MPI TASKS HAVE BEEN INITIATED. !*** IF INSUFFICIENT MPI TASK HAVE BEEN INITIATED THE !*** CODE WILL STOP IN SETUP_SERVERS !*** CALL SETUP_SERVERS(INPES*JNPES, & MYPE, & NPES, & IQUILT_GROUP, & INUMQ, & MPI_COMM_COMP, & MPI_COMM_INTER, & MPI_COMM_INTER_ARRAY) IF(MYPE == 0)THEN CALL W3TAGB('ETAFCST ',0097,0365,0060,'NP22 ') ENDIF IF(MYPE == NPES)THEN ! p CALL START() ENDIF !*** !*** AT THIS POINT NPES IS THE NUMBER OF MPI TASKS WORKING ON THE !*** MODEL INTEGRATION. ALL OTHER TASKS ARE I/O SERVERS. !*** AND AWAY WE GO ! !*** IF(MYPE >= NPES)THEN !*** FIRE UP THE I/O SERVERS CALL QUILT ELSE !*** !*** THESE ARE THE TASKS THAT DO THE MODEL INTEGRATION !*** !----------------------------------------------------------------------- mpp_tim= 0. bocoh_tim= 0. bocov_tim= 0. chkout_tim=0. cltend_tim=0. cucnvc_tim=0. ddamp_tim= 0. divhoa_tim=0. exch_tim= 0. goss_tim= 0. gscond_tim=0. gsmdrive_tim=0. hdiff_tim= 0. hzadv_tim= 0. hzadv2_tim=0. init_tim= 0. nhb_tim= 0. pdnew_tim= 0. pdtedt_tim=0. pgcor_tim= 0. precpd_tim= 0. ! l pptadj_tim=0. ! l radtn_tim= 0. rdtemp_tim=0. res_tim= 0. surfce_tim=0. turbl_tim= 0. vtadv_tim= 0. vadz_tim= 0. hadz_tim= 0. eps_tim= 0. !----------------------------------------------------------------------- !*** !*** INITIALIZE ALL QUANTITIES ASSOCIATED WITH GRID DECOMPOSITION !*** btimx=timef() btim=timef() CALL MPPINIT mpp_tim=mpp_tim+timef()-btim !----------------------------------------------------------------------- !--------INITIALIZE CONSTANTS AND VARIABLES----------------------------- !--------DISTRIBUTE THE VALUES TO THE VARIOUS NODES/PEs----------------- !----------------------------------------------------------------------- IF (MYPE == 0) THEN write(6,*) 'lendo a QUANTIDADE DE TIPOS DE SOLO ' ENDIF open(1,file='TYPSOLO',form='formatted',status='old') read(1,110)NSOTYP 110 format(I2) close(1) IF (MYPE == 0) THEN write(6,*) 'NSOTY: ',NSOTYP ENDIF OPEN(UNIT=1,FILE='GSPREC.nml',STATUS='old') READ(1,GSPRECNML) CLOSE(1) IF (MYPE == 0) THEN IF (GSPREC) THEN write(6,*) 'UTILIZANDO: FERRIER' ELSE write(6,*) 'UTILIZANDO: ZHAO' ENDIF ENDIF OPEN(UNIT=9,FILE="slope.nml",STATUS="OLD") READ(9,SLOPENML) CLOSE(9) WRITE(*,SLOPENML) bbtim=timef() IF (SLOPE) THEN CALL INITS ELSE CALL INIT END IF init_tim=timef()-bbtim btim=timef() CALL GOSSIP goss_tim=goss_tim+timef()-btim !----------------------------------------------------------------------- !--------INVOKE THE LYNCH DIGITAL FILTER IF DESIRED-------------------- !----------------------------------------------------------------------- ! DO NFLT=1,3 ! IF(.NOT.NEST.AND.NFLT.GT.1.AND.MYPE.EQ.0)THEN ! REWIND NBC ! READ(NBC) ! READ(NBC)BCHR ! ENDIF ! CALL DIGFLT ! ENDDO CALL GETENV("tmmark",ENVAR) ! IF(MYPE.EQ.0) PRINT *, "EBU finds that tmmark =",ENVAR write(0,*) "EBU finds that tmmark =",ENVAR IF(ENVAR /= 'tm00') then ! p write(srfile,10) envar 10 format('SR.',a4) ! p open(90,file=srfile,form='unformatted') ! p CALL READPCP endif ! L !----------------------------------------------------------------------- CLTEND_test= .TRUE. IF (NPHS /= NCNVC) THEN CLTEND_test= .FALSE. IF (ENVAR /= 'tm00') THEN WRITE(0,"(A)") 'WARNING: RESULTS COULD BE IN ERROR !' ! WRITE(6,"(A)") 'WARNING: RESULTS COULD BE IN ERROR !' ENDIF ENDIF !----------------------------------------------------------------------- !-------- Special consideration when NTSD=0 at start of forecast ------- !----------------------------------------------------------------------- IF (NTSD == 0) NTSD=1 !----------------------------------------------------------------------- !----- Called at beginning every time in order to test cycling !----------------------------------------------------------------------- IF ( MOD(NTSD,NRADS).EQ.1 .OR. MOD(NTSD,NRADL).EQ.1 ) THEN btim=timef() CALL RADTN radtn_tim=radtn_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !------------------GENERATE INITIAL OUTPUT------------------------------ !----------------------------------------------------------------------- btim=timef() CALL CHKOUT chkout_tim=chkout_tim+timef()-btim IF (NTSD == 1) NTSD=0 !----------------------------------------------------------------------- !********ENTRY INTO THE TIME LOOP*************************************** !----------------------------------------------------------------------- 2000 CONTINUE NTSD=NTSD+1 ! IF(MYPE.EQ.0)WRITE(6,2001) NTSD,(NTSD-1)*DT,(NTSD-1)*DT/3600. IF(MYPE == 0)WRITE(0,2001) NTSD,(NTSD-1)*DT,(NTSD-1)*DT/3600. 2001 FORMAT('EBU: TIMESTEP NTSD=',I5,' FCST TIME=',F7.0,' s', & ' and ',F6.3,' h') !----------------------------------------------------------------------- !*** START THE ADJUSTMENT STEP: INTEGRATE FORWARD THE CONTINUITY !*** EQUATION (UPDATE THE MASS FIELD) !----------------------------------------------------------------------- !*** !*** DIVERGENCE AND HORIZONTAL PART OF THE OMEGA-ALPHA TERM !*** IF(NTSD > 1)CALL EXCH(T,LM,U,LM,V,LM,Q,LM,2,2) IF( .NOT. HYDRO)THEN IF(NTSD > 1)CALL EXCH(DWDT,LM,PINT,LM+1,5,5) ENDIF btim=timef() IF (SLOPE) THEN ! LG CALL DIVHOAS CALL DIVHOASTQL !! CALL DIVHOAST ELSE CALL DIVHOA END IF divhoa_tim=divhoa_tim+timef()-btim !----------------------------------------------------------------------- !--------PRESSURE TENDENCY, ETA/SIGMA DOT, VERTICAL OMEGA-ALPHA--------- !----------------------------------------------------------------------- btim=timef() CALL EXCH(PD,1,DIV,LM,PINT,LM+1,2,2) exch_tim=exch_tim+timef()-btim btim=timef() CALL PDTEDT !Contains call to EXCH pdtedt_tim=pdtedt_tim+timef()-btim !----------------------------------------------------------------------- !--------DO VERTICAL ADVECTION WITHIN THE FIRST ADJUSTMENT STEP--------- !----------------------------------------------------------------------- IF(MOD(NTSD-1,IDTAD) == 0)THEN btim=timef() CALL EXCH(ETADT,LM-1,1,1) exch_tim=exch_tim+timef()-btim btim=timef() CALL VTADV vtadv_tim=vtadv_tim+timef()-btim btim=timef() CALL EXCH(T,LM,U,LM,V,LM,Q,LM,Q2,LM,1,1) exch_tim=exch_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !--------UPDATING PRESSURE DIFFERENCE----------------------------------- !----------------------------------------------------------------------- btim=timef() CALL PDNEW pdnew_tim=pdnew_tim+timef()-btim !----------------------------------------------------------------------- !--------UPDATING BOUNDARY VALUES AT HEIGHT POINTS---------------------- !----------------------------------------------------------------------- btim=timef() IF(MOD(NTSD,IDTAD) == 0)THEN CALL EXCH(T,LM,Q,LM,Q2,LM,1,1) ENDIF CALL EXCH(PD,1,CWM,LM,1,1) exch_tim=exch_tim+timef()-btim btim=timef() CALL BOCOH bocoh_tim=bocoh_tim+timef()-btim !----------------------------------------------------------------------- !*** INTEGRATE BACKWARD THE MOMENTUM EQUATION !*** (UPDATE THE WIND FIELD) !----------------------------------------------------------------------- !*** PRESSURE GRADIENT AND CORIOLIS FORCE TERMS btim=timef() CALL EXCH(PD,1,T,LM,Q,LM,2,2) IF( .NOT. HYDRO)THEN CALL EXCH(PINT,LM+1,5,5) ENDIF exch_tim=exch_tim+timef()-btim btim=timef() CALL PGCOR pgcor_tim=pgcor_tim+timef()-btim btim=timef() CALL EXCH(PDSL,1,5,5) exch_tim=exch_tim+timef()-btim !----------------------------------------------------------------------- !--------DIVERGENCE DAMPING--------------------------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD,NTDDMP) == 0)THEN btim=timef() CALL EXCH(T,LM,U,LM,V,LM,DIV,LM,1,1) exch_tim=exch_tim+timef()-btim btim=timef() CALL DDAMP ddamp_tim=ddamp_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !--------UPDATING BOUNDARY VALUES AT VELOCITY POINTS-------------------- !----------------------------------------------------------------------- btim=timef() CALL EXCH(U,LM,V,LM,1,1) exch_tim=exch_tim+timef()-btim btim=timef() CALL BOCOV bocov_tim=bocov_tim+timef()-btim !----------------------------------------------------------------------- !*** !*** THE ADJUSTMENT STEP IS NOW DONE. MAKE THE REMAINING CALLS WHICH !*** TRADITIONALLY (SO FAR) HAVE BEEN DONE EVERY ADJUSTMENT STEP !*** !----------------------------------------------------------------------- !--------APPLY TEMPERATURE TENDENCY DUE TO RADIATION-------------------- !----------------------------------------------------------------------- btim=timef() CALL RDTEMP rdtemp_tim=rdtemp_tim+timef()-btim !----------------------------------------------------------------------- !--------LATERAL DIFFUSION---------------------------------------------- !----------------------------------------------------------------------- btim=timef() CALL EXCH(T,LM,U,LM,V,LM,Q,LM,2,2) CALL EXCH(Q2,LM,1,1) exch_tim=exch_tim+timef()-btim btim=timef() IF (SLOPE) THEN CALL HDIFFS ELSE CALL HDIFF END IF hdiff_tim=hdiff_tim+timef()-btim !----------------------------------------------------------------------- !------- HORIZONTAL ADVECTION ------------------------------------------ !----------------------------------------------------------------------- IF(MOD(NTSD,IDTAD) == 0)THEN btim=timef() CALL EXCH(T,LM,U,LM,V,LM,4,4) CALL EXCH(Q2,LM,5,5) exch_tim=exch_tim+timef()-btim btim=timef() IF (SLOPE) THEN CALL HZADVS ! LG CALL SLADVT ELSE CALL HZADV ! CALL HZADV_LM1 END IF hzadv_tim=hzadv_tim+timef()-btim btim=timef() CALL EXCH(U,LM,V,LM,Q,LM,CWM,LM,2,2) exch_tim=exch_tim+timef()-btim !*** HORIZONTAL ADVECTION OF WATER SUBSTANCE btim=timef() CALL HZADV2 hzadv2_tim=hzadv2_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !*** IF THE TIME IS RIGHT, NOW DO VARIOUS PHYSICS CALLS !*** (WARNING: TO AVOID ENDING THE INTEGRATION WITH PHYSICS CALLS !*** WHICH HAVE NOT BEEN FOLLOWED BY ADJUSTMENT STEPS, PHYSICS CALLS !*** ARE OFFSET BY HALVES OF VARIOUS CALLING INTERVALS. IT IS !*** ASSUMED THAT THE CALLING INTERVALS, NPHS AND NCNVC, !*** ARE DIVISIBLE BY IDTAD. IF NOT, INTEGRATION WILL END WITH AN !*** INCORRECT NUMBER OF CALLS HAVING BEEN MADE. !----------------------------------------------------------------------- !--------TURBULENT PROCESSES AND PRECIPITATION-------------------------- !----------------------------------------------------------------------- IF(MOD(NTSD-NPHS/2,NPHS) == 0)THEN IF (MYPE.EQ.0) THEN WRITE(0,"(a)") 'EBU: Physics time step' ! WRITE(6,"(a)") 'EBU: Physics time step' ENDIF btim=timef() CALL EXCH(PD,1,UZ0,1,VZ0,1,T,LM,U,LM,V,LM,Q,LM,1,1) exch_tim=exch_tim+timef()-btim btim=timef() CALL TURBL !Contains calls to EXCH turbl_tim=turbl_tim+timef()-btim !----------------------------------------------------------------------- !--- Store original temperature array !----------------------------------------------------------------------- IF (CLTEND_test) THEN btim=timef() ICLTEND=-1 CALL CLTEND (ICLTEND) cltend_tim=cltend_tim+timef()-btim ENDIF if (.not. GSPREC) then btim=timef() CALL GSCOND gscond_tim=gscond_tim+timef()-btim endif !----------------------------------------------------------------------- !--------CONVECTIVE PRECIPITATION--------------------------------------- !----------------------------------------------------------------------- btim=timef() ! CALL CUCNVC cucnvc_tim=cucnvc_tim+timef()-btim !----------------------------------------------------------------------- !-- GRIDSCALE MICROPHYSICS (CONDENSATION & PRECIPITATION; forecast only !----------------------------------------------------------------------- if (GSPREC) then btim=timef() CALL GSMDRIVE gsmdrive_tim=gsmdrive_tim+timef()-btim else !----------------------------------------------------------------------- !-- GRIDSCALE ZHAO MICROPHYSICS !----------------------------------------------------------------------- btim=timef() CALL PRECPD precpd_tim=precpd_tim+timef()-btim endif !----------------------------------------------------------------------- !--------PRECIPIPTATION ASSIMILATION------------------------------------ !----------------------------------------------------------------------- ! IF (ENVAR .NE. 'tm00') THEN ! btim=timef() ! CALL CHKSNOW ! CALL ADJPPT ! pptadj_tim=pptadj_tim+timef()-btim ! ENDIF !----------------------------------------------------------------------- !-------- Calculate temp tendencies and restore original temps --------- !----------------------------------------------------------------------- IF (CLTEND_test) THEN btim=timef() ICLTEND=0 CALL CLTEND (ICLTEND) cltend_tim=cltend_tim+timef()-btim ENDIF !-------------------------------- !----- End physics IF loop ------ !-------------------------------- ENDIF !----------------------------------------------------------------------- !----- Update temp tendencies from cloud processes every time step ----- !----------------------------------------------------------------------- IF (CLTEND_test) THEN btim=timef() ICLTEND=1 CALL CLTEND (ICLTEND) cltend_tim=cltend_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !-------------------VERTICAL ADVECTION OF HEIGHT------------------------ !----------------------------------------------------------------------- btim=timef() CALL VADZ vadz_tim=vadz_tim+timef()-btim !----------------------------------------------------------------------- !-------------------HORIZONTAL ADVECTION OF HEIGHT---------------------- !----------------------------------------------------------------------- IF( .NOT. HYDRO)THEN btim=timef() CALL EXCH(U,LM,V,LM,1,1) CALL EXCH(Z,LM+1,2,2) exch_tim=exch_tim+timef()-btim ENDIF btim=timef() CALL HADZ hadz_tim=hadz_tim+timef()-btim !----------------------------------------------------------------------- !------------------------ ADVECTION OF W ------------------------------- !----------------------------------------------------------------------- IF(HYDRO)THEN btim=timef() CALL EXCH(PDSL,1,2,2) CALL EXCH(PINT,LM+1,3,3) exch_tim=exch_tim+timef()-btim ELSE btim=timef() CALL EXCH(PDSL,1,2,2) CALL EXCH(U,LM,V,LM,DWDT,LM,PINT,LM+1,W,LM+1,3,3) exch_tim=exch_tim+timef()-btim ENDIF btim=timef() CALL EPS eps_tim=eps_tim+timef()-btim IF(NTSD > NSTART+1)THEN !----------------------------------------------------------------------- !------------------------RADIATION-------------------------------------- !----------------------------------------------------------------------- IF ( MOD(NTSD,NRADS).EQ.1 .OR. MOD(NTSD,NRADL).EQ.1 ) THEN btim=timef() CALL RADTN radtn_tim=radtn_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !--------IS IT TIME FOR A CHECK POINT ON THE MODEL HISTORY FILE?-------- !----------------------------------------------------------------------- btim=timef() CALL CHKOUT chkout_tim=chkout_tim+timef()-btim ENDIF !----------------------------------------------------------------------- !--------CLEAN UP AFTER RESTART----------------------------------------- !----------------------------------------------------------------------- IF(RESTRT)THEN RESTRT= .FALSE. ENDIF !----------------------------------------------------------------------- IF(NTSD < NTSTM)GO TO 2000 !*********************************************************************** !************** EXIT FROM THE TIME LOOP ************************** !*********************************************************************** 2005 continue tot2_tim=timef()-btimx tot_tim=mpp_tim+init_tim+goss_tim+radtn_tim+chkout_tim+ & divhoa_tim+pdtedt_tim+vtadv_tim+pdnew_tim+bocoh_tim+ & pgcor_tim+ddamp_tim+bocov_tim+rdtemp_tim+hdiff_tim+ & hzadv_tim+hzadv2_tim+turbl_tim+gscond_tim+cucnvc_tim+ & exch_tim+gsmdrive_tim+cltend_tim+ & vadz_tim+hadz_tim+eps_tim+precpd_tim if(mype == 0)then pct=mpp_tim/tot_tim*1.e2 write(6,*)' mpp=',mpp_tim*1.e-3,' pct=',pct pct=init_tim/tot_tim*1.e2 write(6,*)' init=',init_tim*1.e-3,' pct=',pct pct=goss_tim/tot_tim*1.e2 write(6,*)' goss=',goss_tim*1.e-3,' pct=',pct pct=radtn_tim/tot_tim*1.e2 write(6,*)' radtn=',radtn_tim*1.e-3,' pct=',pct pct=chkout_tim/tot_tim*1.e2 write(6,*)' chkout=',chkout_tim*1.e-3,' pct=',pct pct=divhoa_tim/tot_tim*1.e2 write(6,*)' divhoa=',divhoa_tim*1.e-3,' pct=',pct pct=pdtedt_tim/tot_tim*1.e2 write(6,*)' pdtedt=',pdtedt_tim*1.e-3,' pct=',pct pct=vtadv_tim/tot_tim*1.e2 write(6,*)' vtadv=',vtadv_tim*1.e-3,' pct=',pct pct=pdnew_tim/tot_tim*1.e2 write(6,*)' pdnew=',pdnew_tim*1.e-3,' pct=',pct pct=bocoh_tim/tot_tim*1.e2 write(6,*)' bocoh=',bocoh_tim*1.e-3,' pct=',pct pct=pgcor_tim/tot_tim*1.e2 write(6,*)' pgcor=',pgcor_tim*1.e-3,' pct=',pct pct=precpd_tim/tot_tim*1.e2 write(6,*)' precpd=',precpd_tim*1.e-3,' pct=',pct pct=ddamp_tim/tot_tim*1.e2 write(6,*)' ddamp=',ddamp_tim*1.e-3,' pct=',pct pct=bocov_tim/tot_tim*1.e2 write(6,*)' bocov=',bocov_tim*1.e-3,' pct=',pct pct=rdtemp_tim/tot_tim*1.e2 write(6,*)' rdtemp=',rdtemp_tim*1.e-3,' pct=',pct pct=hdiff_tim/tot_tim*1.e2 write(6,*)' hdiff=',hdiff_tim*1.e-3,' pct=',pct pct=hzadv_tim/tot_tim*1.e2 write(6,*)' hzadv=',hzadv_tim*1.e-3,' pct=',pct pct=hzadv2_tim/tot_tim*1.e2 write(6,*)' hzadv2=',hzadv2_tim*1.e-3,' pct=',pct pct=vadz_tim/tot2_tim*1.e2 write(6,*)' vadz=',vadz_tim*1.e-3,' pct=',pct pct=hadz_tim/tot2_tim*1.e2 write(6,*)' hadz=',hadz_tim*1.e-3,' pct=',pct pct=eps_tim/tot2_tim*1.e2 write(6,*)' eps=',eps_tim*1.e-3,' pct=',pct pct=turbl_tim/tot_tim*1.e2 write(6,*)' turbl=',turbl_tim*1.e-3,' pct=',pct pct=cucnvc_tim/tot_tim*1.e2 write(6,*)' cucnvc=',cucnvc_tim*1.e-3,' pct=',pct pct=gsmdrive_tim/tot_tim*1.e2 write(6,*)' gsmdrive=',gsmdrive_tim*1.e-3,' pct=',pct pct=cltend_tim/tot_tim*1.e2 write(6,*)' cltend=',cltend_tim*1.e-3,' pct=',pct pct=exch_tim/tot_tim*1.e2 write(6,*)' exch=',exch_tim*1.e-3,' pct=',pct write(6,*)' total=',tot_tim*1.e-3 write(6,*)' total2=',tot2_tim*1.e-3 endif !---------------------------------------------------------------------- !*** WE MUST NOW SHUT DOWN THE I/O SERVERS !*** THIS IS DONE BY SENDING A -999 TO MPI TASK 0 OF EACH SERVER GROUP IF(MYPE == 0)THEN DO I=1,IQUILT_GROUP CALL MPI_SEND(-999,1,MPI_INTEGER,0,0, & MPI_COMM_INTER_ARRAY(I),IER) ENDDO ENDIF !---------------------------------------------------------------------- !---------------------------------------------------------------------- ENDIF ! ENDIF ON TASKS FOR MODEL INTEGRATION VS I/O SERVING !---------------------------------------------------------------------- !---------------------------------------------------------------------- CALL MPI_BARRIER(MPI_COMM_WORLD,IERR) IF(MYPE == 0) THEN CALL W3TAGE('ETAFCST ') ENDIF IF(MYPE == NPES)THEN ! p CALL SUMMARY() ENDIF CALL MPI_FINALIZE(IERR) !---------------------------------------------------------------------- !---------------------------------------------------------------------- STOP END PROGRAM