diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 1bca9b004..fa8a549d6 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -70,11 +70,14 @@ module fv3atm_cap_mod logical, allocatable :: is_moving_FB(:) logical :: profile_memory = .true. + logical :: write_runtimelog = .false. + logical :: lprint = .false. integer :: mype = -1 integer :: dbug = 0 integer :: frestart(999) = -1 + real(kind=8) :: timere, timep2re !----------------------------------------------------------------------- contains @@ -246,6 +249,11 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return profile_memory = (trim(value)/="false") + call ESMF_AttributeGet(gcomp, name="RunTimeLog", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write_runtimelog = (trim(value)=="true") + call ESMF_AttributeGet(gcomp, name="DumpFields", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -347,6 +355,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return first_kdt = 1 + if( mype == 0) lprint = .true. ! !####################################################################### ! set up fcst grid component @@ -486,6 +495,7 @@ subroutine InitializeAdvertise(gcomp, rc) enddo k = k + wrttasks_per_group_from_parent last_wrttask(i) = k - 1 + if( mype == lead_wrttask(i) ) lprint = .true. ! if(mype==0)print *,'af wrtComp(i)=',i,'k=',k ! prepare name of the wrtComp(i) @@ -971,8 +981,7 @@ subroutine InitializeAdvertise(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if(mype==0) print *,'in fv3_cap, aft import, export fields in atmos' - if(mype==0) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis + if(write_runtimelog .and. lprint) print *,'in fv3_cap, init time=',MPI_Wtime()-timeis,mype !----------------------------------------------------------------------- ! end subroutine InitializeAdvertise @@ -989,7 +998,10 @@ subroutine InitializeRealize(gcomp, rc) type(ESMF_State) :: importState, exportState integer :: urc + real(8) :: MPI_Wtime, timeirs + rc = ESMF_SUCCESS + timeirs = MPI_Wtime() ! query for importState and exportState call NUOPC_ModelGet(gcomp, driverClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -1004,6 +1016,11 @@ subroutine InitializeRealize(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + timere = 0. + timep2re = 0. + + if(write_runtimelog .and. lprint) print *,'in fv3_cap, initirealz time=',MPI_Wtime()-timeirs,mype + end subroutine InitializeRealize !----------------------------------------------------------------------------- @@ -1012,10 +1029,13 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc + real(kind=8) :: MPI_Wtime, timers !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timers = MPI_Wtime() + if(write_runtimelog .and. timere>0. .and. lprint) print *,'in fv3_cap, time between fv3 run step=', timers-timere,mype if (profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance: ") @@ -1027,6 +1047,9 @@ subroutine ModelAdvance(gcomp, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance: ") + timere = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap, time in fv3 run step=', timere-timers, mype + end subroutine ModelAdvance !----------------------------------------------------------------------------- @@ -1041,10 +1064,13 @@ subroutine ModelAdvance_phase1(gcomp, rc) logical :: fcstpe character(len=*),parameter :: subname='(fv3_cap:ModelAdvance_phase1)' character(240) :: msgString + real(kind=8) :: MPI_Wtime, timep1rs, timep1re !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep1rs = MPI_Wtime() + if(write_runtimelog .and. timep2re>0. .and. lprint) print *,'in fv3_cap, time between fv3 run phase2 and phase1 ', timep1rs-timep2re,mype if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase1: ") @@ -1074,6 +1100,8 @@ subroutine ModelAdvance_phase1(gcomp, rc) call diagnose_cplFields(gcomp, clock, fcstpe, cplprint_flag, dbug, 'import') endif + timep1re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase1 time ', timep1re-timep1rs,mype if (profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase1: ") end subroutine ModelAdvance_phase1 @@ -1100,9 +1128,12 @@ subroutine ModelAdvance_phase2(gcomp, rc) type(ESMF_Clock) :: clock, clock_out integer :: fieldCount + real(kind=8) :: MPI_Wtime, timep2rs + !----------------------------------------------------------------------------- rc = ESMF_SUCCESS + timep2rs = MPI_Wtime() if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 ModelAdvance_phase2: ") @@ -1206,6 +1237,8 @@ subroutine ModelAdvance_phase2(gcomp, rc) call diagnose_cplFields(gcomp, clock_out, fcstpe, cplprint_flag, dbug, 'export') end if + timep2re = MPI_Wtime() + if(write_runtimelog .and. lprint) print *,'in fv3_cap,modeladvance phase2 time ', timep2re-timep2rs, mype if(profile_memory) call ESMF_VMLogMemInfo("Leaving FV3 ModelAdvance_phase2: ") end subroutine ModelAdvance_phase2 @@ -1380,8 +1413,8 @@ subroutine ModelFinalize(gcomp, rc) !----------------------------------------------------------------------------- !*** finialize forecast - timeffs = MPI_Wtime() rc = ESMF_SUCCESS + timeffs = MPI_Wtime() ! call ESMF_GridCompGet(gcomp,vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1414,7 +1447,7 @@ subroutine ModelFinalize(gcomp, rc) call ESMF_GridCompDestroy(fcstComp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! - if(mype==0)print *,' wrt grid comp destroy time=',MPI_Wtime()-timeffs + if(write_runtimelog .and. lprint) print *,'in fv3_cap, finalize time=',MPI_Wtime()-timeffs, mype end subroutine ModelFinalize ! diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index c8fc139e2..162362466 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2090,7 +2090,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (mype == lead_write_task) then !** write out inline post log file open(newunit=nolog,file='log.atm.inlinepost.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif if (lprnt) then @@ -2224,7 +2226,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) endif call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif - if (wrt_int_state%mype == 0) then + if (lprnt) then print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) endif @@ -2393,7 +2395,9 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (out_phase == 1 .and. mype == lead_write_task) then !** write out log file open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') - write(nolog,"(' completed fv3atm fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + write(nolog,"('completed: fv3atm')") + write(nolog,"('forecast hour: ',f10.3)") nfhour + write(nolog,"('valid time: ',6(i4,2x))") wrt_int_state%fdate(1:6) close(nolog) endif enddo two_phase_loop diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 696a6b026..2026b67d9 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -93,7 +93,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & its = wrt_int_state%out_grid_info(grid_id)%i_start !<-- Starting I of this write task's subsection ite = wrt_int_state%out_grid_info(grid_id)%i_end !<-- Ending I of this write task's subsection - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg, & + if(mype==0) print *,'in post_run, numx=',numx,'its=',its,'ite=',ite,'nwtpg=',nwtpg, & 'jts=',jts,'jte=',jte,'maptype=',maptype,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! @@ -508,7 +508,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, & qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, & q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, & - pint, exch_h, ref_10cm, qqni, qqnr, qqnwfa, & + pint, exch_h, ref_10cm, qqni, qqnr, qqnw, qqnwfa, & qqnifa, effri, effrl, effrs, aextc55, taod5503d, & duem, dusd, dudp, duwt, dusv, ssem, sssd, ssdp, & sswt, sssv, bcem, bcsd, bcdp, bcwt, bcsv, ocem, & @@ -3642,8 +3642,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) endif if(imp_physics == 8) then - ! model level rain number - if(trim(fieldname)=='ncrain') then + ! model level rain water number + if(trim(fieldname)=='rain_nc') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnr,arrayr43d,spval,fillvalue) do l=1,lm do j=jsta,jend @@ -3655,8 +3655,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif - ! model level rain number - if(trim(fieldname)=='ncice') then + ! model level cloud ice number + if(trim(fieldname)=='nicp') then !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqni,arrayr43d,spval,fillvalue) do l=1,lm do j=jsta,jend @@ -3668,6 +3668,19 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) enddo endif + ! model level cloud water number + if(trim(fieldname)=='water_nc') then + !$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqnw,arrayr43d,spval,fillvalue) + do l=1,lm + do j=jsta,jend + do i=ista, iend + qqnw(i,j,l)=arrayr43d(i,j,l) + if(abs(arrayr43d(i,j,l)-fillvalue)