From fc0aa3cbadfc937e4a6d024c5d30911aee8db0a5 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Fri, 15 Dec 2023 16:35:29 +0000 Subject: [PATCH 1/9] set up fhour with multiple values --- atmos_model.F90 | 26 ++++++++++++++++++-------- ccpp/data/GFS_typedefs.F90 | 23 +++++++++++++++++++---- 2 files changed, 37 insertions(+), 12 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 25cc61a88..2ed223aac 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -788,6 +788,13 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- WARNING: For special cases that model needs to restart at non-multiple of fhzero !--- the fields in first output files are not accumulated from the beginning of !--- the bucket, but the restart time. + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzer_array(i) > 0.) then + GFS_Control%fhzero = GFS_Control%fhzero_array(i) + endif + enddo fhzero_loop + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. + if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0) if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero' @@ -1000,16 +1007,19 @@ subroutine update_atmos_model_state (Atmos, rc) GFS_control%levs, 1, 1, 1.0_GFS_kind_phys, time_int, time_intfull, & GFS_control%fhswr, GFS_control%fhlwr) endif - if (nint(GFS_control%fhzero) > 0) then - if (mod(isec,3600*nint(GFS_control%fhzero)) == 0) diag_time = Atmos%Time - else - if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time - endif - call diag_send_complete_instant (Atmos%Time) + !--- find current fhzero + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzer_array(i) > 0.) then + GFS_Control%fhzero = GFS_Control%fhzero_array(i) + endif + enddo fhzero_loop + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. - !--- this may not be necessary once write_component is fully implemented - !!!call diag_send_complete_extra (Atmos%Time) + if (nint(GFS_Control%fhzero) > 0) then + if (mod(isec,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time + endif + call diag_send_complete_instant (Atmos%Time) !--- get bottom layer data from dynamical core for coupling call atmosphere_get_bottom_layer (Atm_block, DYCORE_Data) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 17d6ee4a0..9b8ccedeb 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -685,7 +685,9 @@ module GFS_typedefs !< for use with internal file reads integer :: input_nml_file_length !< length (number of lines) in namelist for internal reads integer :: logunit - real(kind=kind_phys) :: fhzero !< hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero !< hours between clearing of diagnostic buckets (current bucket) + real(kind=kind_phys) :: fhzero_array(2) !< array to hold the the hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero_fhour(2) !< the maximum forecast length for the hours between clearing of diagnostic buckets logical :: ldiag3d !< flag for 3d diagnostic fields logical :: qdiag3d !< flag for 3d tracer diagnostic fields logical :: flag_for_gwd_generic_tend !< true if GFS_GWD_generic should calculate tendencies @@ -3238,6 +3240,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- BEGIN NAMELIST VARIABLES real(kind=kind_phys) :: fhzero = 0.0 !< hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero_array(1:2) = 0.0 !< array with hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero_fhour(1:2) = 0.0 !< the maximum forecast length for the hours between clearing of diagnostic buckets logical :: ldiag3d = .false. !< flag for 3d diagnostic fields logical :: qdiag3d = .false. !< flag for 3d tracer diagnostic fields logical :: lssav = .false. !< logical flag for storing diagnostics @@ -3884,9 +3888,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & NAMELIST /gfs_physics_nml/ & !--- general parameters - fhzero, ldiag3d, qdiag3d, lssav, naux2d, dtend_select, & - naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & - thermodyn_id, sfcpress_id, & + fhzero, fhzero_array, fhzero_fhour, ldiag3d, qdiag3d, lssav, & + naux2d, dtend_select, naux3d, aux2d_time_avg, & + aux3d_time_avg, thermodyn_id, sfcpress_id, & !--- coupling parameters cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_sd, & @@ -4095,6 +4099,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%fn_nml = fn_nml Model%logunit = logunit Model%fhzero = fhzero + Model%fhzero_array = fhzero_array + Model%fhzero_fhour = fhzero_fhour + if( Model%fhzero_array(1) > 0. ) then + Model%fhzero = Model%fhzero_array(1) + endif Model%ldiag3d = ldiag3d Model%qdiag3d = qdiag3d if (qdiag3d .and. .not. ldiag3d) then @@ -5523,6 +5532,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%restart = restart Model%lsm_cold_start = .not. restart Model%hydrostatic = hydrostatic + if (Model%me == Model%master) then + print *,'in atm phys init, phour=',Model%phour,'fhour=',Model%fhour,'zhour=',Model%zhour,'kdt=',Model%kdt + endif + if(Model%hydrostatic .and. Model%lightning_threat) then write(0,*) 'Turning off lightning threat index for hydrostatic run.' @@ -6316,6 +6329,8 @@ subroutine control_print(Model) print *, ' nlunit : ', Model%nlunit print *, ' fn_nml : ', trim(Model%fn_nml) print *, ' fhzero : ', Model%fhzero + print *, ' fhzero_array : ', Model%fhzero_array + print *, ' fhzero_fhour : ', Model%fhzero_fhour print *, ' ldiag3d : ', Model%ldiag3d print *, ' qdiag3d : ', Model%qdiag3d print *, ' lssav : ', Model%lssav From c830bda996311decb6a986e85f75e2ecdeddbbcb Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 18 Dec 2023 21:01:54 +0000 Subject: [PATCH 2/9] updates for diag time --- atmos_model.F90 | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 2ed223aac..7bda3e1e8 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -533,7 +533,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) type (time_type), intent(in) :: Time_init, Time, Time_step !--- local variables --- integer :: unit, i - integer :: mlon, mlat, nlon, nlat, nlev, sec + integer :: mlon, mlat, nlon, nlat, nlev, sec, sec_lastfhzerofh integer :: ierr, io, logunit integer :: tile_num integer :: isc, iec, jsc, jec @@ -789,14 +789,19 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- the fields in first output files are not accumulated from the beginning of !--- the bucket, but the restart time. fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzer_array(i) > 0.) then + if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzero_array(i) > 0.) then GFS_Control%fhzero = GFS_Control%fhzero_array(i) + if (i > 1) then + sec_lastfhzerofh = int(GFS_Control%fhzero_fhour(i-1) * 3600) + else + sec_lastfhzerofh = 0 + endif endif enddo fhzero_loop if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. - if (mod(sec,int(GFS_Control%fhzero*3600.)) /= 0) then - diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.),int(GFS_Control%fhzero))*3600.0) + if (mod((sec-sec_lastfhzerofh),int(GFS_Control%fhzero*3600.)) /= 0) then + diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.-sec_lastfhzerofh),int(GFS_Control%fhzero))*3600.0) if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero' endif if (Atmos%iau_offset > zero) then @@ -955,7 +960,7 @@ subroutine update_atmos_model_state (Atmos, rc) type (atmos_data_type), intent(inout) :: Atmos integer, optional, intent(out) :: rc !--- local variables - integer :: localrc + integer :: i, localrc, sec_lastfhzerofh integer :: isec, seconds, isec_fhzero real(kind=GFS_kind_phys) :: time_int, time_intfull ! @@ -1010,14 +1015,19 @@ subroutine update_atmos_model_state (Atmos, rc) !--- find current fhzero fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzer_array(i) > 0.) then + if( seconds < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzero_array(i) > 0.) then GFS_Control%fhzero = GFS_Control%fhzero_array(i) + if (i > 1) then + sec_lastfhzerofh = int(GFS_Control%fhzero_fhour(i-1) * 3600) + else + sec_lastfhzerofh = 0 + endif endif enddo fhzero_loop if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. if (nint(GFS_Control%fhzero) > 0) then - if (mod(isec,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time + if (mod(isec - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time endif call diag_send_complete_instant (Atmos%Time) From 1113fa4d05f494f5b96929536214afb61452794d Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Tue, 16 Jan 2024 20:47:05 +0000 Subject: [PATCH 3/9] add fixes for two bucket --- atmos_model.F90 | 72 ++++++++++++++++++++++++++------------ ccpp/data/GFS_typedefs.F90 | 6 ++-- 2 files changed, 53 insertions(+), 25 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 7bda3e1e8..e4e930866 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -538,7 +538,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) integer :: tile_num integer :: isc, iec, jsc, jec real(kind=GFS_kind_phys) :: dt_phys - logical :: p_hydro, hydro + logical :: p_hydro, hydro, tmpflag logical, save :: block_message = .true. type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) @@ -788,20 +788,33 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- WARNING: For special cases that model needs to restart at non-multiple of fhzero !--- the fields in first output files are not accumulated from the beginning of !--- the bucket, but the restart time. - fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - if( sec < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzero_array(i) > 0.) then - GFS_Control%fhzero = GFS_Control%fhzero_array(i) - if (i > 1) then - sec_lastfhzerofh = int(GFS_Control%fhzero_fhour(i-1) * 3600) - else - sec_lastfhzerofh = 0 + if( GFS_Control%fhzero_array(1) > 0. ) then + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + tmpflag = .false. + if( GFS_Control%fhzero_array(i) > 0.) then + if( i == 1 ) then + if( sec <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag = .true. + else if( i > 1 ) then + if( sec > GFS_Control%fhzero_fhour(i-1)*3600. .and. sec <=GFS_Control%fhzero_fhour(i)*3600. ) & + tmpflag = .true. + endif + if( tmpflag ) then + GFS_Control%fhzero = GFS_Control%fhzero_array(i) + if( GFS_Control%fhzero > 0) then + sec_lastfhzerofh = (int(sec/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600 + else + sec_lastfhzerofh = 0 + endif + endif endif - endif - enddo fhzero_loop - if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. + enddo fhzero_loop + else + sec_lastfhzerofh = 0 + endif + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600.,sec_lastfhzerofh/3600 if (mod((sec-sec_lastfhzerofh),int(GFS_Control%fhzero*3600.)) /= 0) then - diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys/3600.-sec_lastfhzerofh),int(GFS_Control%fhzero))*3600.0) + diag_time = Time - real_to_time_type(mod(int((GFS_Control%kdt - 1)*dt_phys-sec_lastfhzerofh),int(GFS_Control%fhzero))*3600.0) if (mpp_pe() == mpp_root_pe()) print *,'Warning: in atmos_init,start at non multiple of fhzero' endif if (Atmos%iau_offset > zero) then @@ -962,6 +975,7 @@ subroutine update_atmos_model_state (Atmos, rc) !--- local variables integer :: i, localrc, sec_lastfhzerofh integer :: isec, seconds, isec_fhzero + logical :: tmpflag real(kind=GFS_kind_phys) :: time_int, time_intfull ! if (present(rc)) rc = ESMF_SUCCESS @@ -1014,20 +1028,34 @@ subroutine update_atmos_model_state (Atmos, rc) endif !--- find current fhzero - fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - if( seconds < GFS_Control%fhzero_fhour(i)*3600. .and. GFS_Control%fhzero_array(i) > 0.) then - GFS_Control%fhzero = GFS_Control%fhzero_array(i) - if (i > 1) then - sec_lastfhzerofh = int(GFS_Control%fhzero_fhour(i-1) * 3600) - else - sec_lastfhzerofh = 0 + if( GFS_Control%fhzero_array(1) > 0. ) then + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + tmpflag = .false. + if( GFS_Control%fhzero_array(i) > 0.) then + if( i == 1 ) then + if( seconds <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag = .true. + else if( i > 1 ) then + if( seconds > GFS_Control%fhzero_fhour(i-1)*3600. .and. seconds <= GFS_Control%fhzero_fhour(i)*3600. ) & + tmpflag = .true. + endif + if( tmpflag) then + GFS_Control%fhzero = GFS_Control%fhzero_array(i) + if( GFS_Control%fhzero > 0) then + sec_lastfhzerofh = (int(seconds/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600 + else + sec_lastfhzerofh = 0 + endif + endif endif - endif - enddo fhzero_loop - if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model, fhzero=',GFS_Control%fhzero, 'fhour=',sec/3600. + enddo fhzero_loop + else + sec_lastfhzerofh = 0 + endif + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update, fhzero=',GFS_Control%fhzero, 'fhour=',seconds/3600.,sec_lastfhzerofh/3600. if (nint(GFS_Control%fhzero) > 0) then if (mod(isec - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update diag_time=',isec/3600.,'last fhzeo=',sec_lastfhzerofh endif call diag_send_complete_instant (Atmos%Time) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 9b8ccedeb..c8bee25f7 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3240,8 +3240,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- BEGIN NAMELIST VARIABLES real(kind=kind_phys) :: fhzero = 0.0 !< hours between clearing of diagnostic buckets - real(kind=kind_phys) :: fhzero_array(1:2) = 0.0 !< array with hours between clearing of diagnostic buckets - real(kind=kind_phys) :: fhzero_fhour(1:2) = 0.0 !< the maximum forecast length for the hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero_array(1:2) = 0.0 !< array with hours between clearing of diagnostic buckets + real(kind=kind_phys) :: fhzero_fhour(1:2) = 0.0 !< the maximum forecast length for the hours between clearing of diagnostic buckets logical :: ldiag3d = .false. !< flag for 3d diagnostic fields logical :: qdiag3d = .false. !< flag for 3d tracer diagnostic fields logical :: lssav = .false. !< logical flag for storing diagnostics @@ -3890,7 +3890,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- general parameters fhzero, fhzero_array, fhzero_fhour, ldiag3d, qdiag3d, lssav, & naux2d, dtend_select, naux3d, aux2d_time_avg, & - aux3d_time_avg, thermodyn_id, sfcpress_id, & + aux3d_time_avg, fhcyc, thermodyn_id, sfcpress_id, & !--- coupling parameters cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_sd, & From e55dd98bb5b0a6daa2d5e6c81512fb28a1b2d1db Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Wed, 24 Jan 2024 16:11:06 +0000 Subject: [PATCH 4/9] comment print --- atmos_model.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index e4e930866..c1a54c138 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1055,7 +1055,7 @@ subroutine update_atmos_model_state (Atmos, rc) if (nint(GFS_Control%fhzero) > 0) then if (mod(isec - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time - if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update diag_time=',isec/3600.,'last fhzeo=',sec_lastfhzerofh +! if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update time=',isec/3600.,'last fhzeo=',sec_lastfhzerofh endif call diag_send_complete_instant (Atmos%Time) From 3a74291610d5c5130406646ccaeea46768c3cf23 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Mon, 29 Jan 2024 14:14:57 +0000 Subject: [PATCH 5/9] Update fhzero global attribute at runtime --- fv3_cap.F90 | 13 ++ io/module_wrt_grid_comp.F90 | 329 ++++++++++++++++++------------------ module_fcst_grid_comp.F90 | 38 +++++ 3 files changed, 220 insertions(+), 160 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 5401e66a5..cbadaeb95 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1063,6 +1063,8 @@ subroutine ModelAdvance_phase2(gcomp, rc) real(kind=8) :: MPI_Wtime, timep2rs + character(len=ESMF_MAXSTR) :: fb_name + type(ESMF_Info) :: info !----------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1124,6 +1126,17 @@ subroutine ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if + ! Update fcstFB attributes from fcst PEs to all PEs in this VM + ! This is needed in case some attributes are updated during run time + call ESMF_FieldBundleGet(fcstFB(j), name=fb_name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (fb_name(1:8) /= "restart_") then + call ESMF_InfoGetFromHost(fcstFB(j), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoBroadcast(info, rootPet=fcstPetList(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + enddo call ESMF_VMEpochExit(rc=rc) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index b7e93e28f..615bd3a64 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -78,6 +78,7 @@ module module_wrt_grid_comp type(ESMF_FieldBundle) :: gridFB integer :: FBCount character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) + character(128) :: FBlist_outfilename(100) logical :: top_parent_is_global ! !----------------------------------------------------------------------- @@ -194,7 +195,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, integer :: attCount, jidx, idx, noutfile character(19) :: newdate - character(128) :: FBlist_outfilename(100), outfile_name + character(128) :: outfile_name character(128),dimension(:,:), allocatable :: outfilename real(8), dimension(:), allocatable :: slat real(8), dimension(:), allocatable :: lat, lon @@ -213,8 +214,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, integer :: grid_id logical :: history_file_on_native_grid - character(len=esmf_maxstr) :: output_grid_name ! + character(ESMF_MAXSTR) :: fb_name1, fb_name2 !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- @@ -1144,129 +1145,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, enddo ! FBCount - ! add output grid related attributes, only for history files(bundles), skip restart - if (FBlist_outfilename(i)(1:8) /= 'restart_') then - - call ESMF_AttributeGet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3-nooutput", & - name="output_grid", value=output_grid_name, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"source","grid "/), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="source", value="FV3GFS", rc=rc) - - if (trim(output_grid_name) == 'cubed_sphere_grid') then - - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="cubed_sphere", rc=rc) - - else if (trim(output_grid_name) == 'gaussian_grid') then - - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="gaussian", rc=rc) - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"im","jm"/), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="im", value=imo(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="jm", value=jmo(grid_id), rc=rc) - - else if (trim(output_grid_name) == 'regional_latlon' & - .or. trim(output_grid_name) == 'regional_latlon_moving' & - .or. trim(output_grid_name) == 'global_latlon') then - - ! for 'regional_latlon_moving' lon1/2 and lat1/2 will be overwritten in run phase - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="latlon", rc=rc) - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"lon1","lat1","lon2","lat2","dlon","dlat"/), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlon", value=dlon(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid_name) /= 'regional_latlon_moving') then - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2(grid_id), rc=rc) - endif - else if (trim(output_grid_name) == 'rotated_latlon' & - .or. trim(output_grid_name) == 'rotated_latlon_moving') then - - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="rotated_latlon", rc=rc) - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"cen_lon",& - "cen_lat",& - "lon1 ",& - "lat1 ",& - "lon2 ",& - "lat2 ",& - "dlon ",& - "dlat "/), rc=rc) - ! for 'rotated_latlon_moving' cen_lon and cen_lat will be overwritten in run phase - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lon", value=cen_lon(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lat", value=cen_lat(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlon", value=dlon(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dlat", value=dlat(grid_id), rc=rc) - if (trim(output_grid_name) /= 'rotated_latlon_moving') then - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2(grid_id), rc=rc) - endif - else if (trim(output_grid_name) == 'lambert_conformal') then - - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="grid", value="lambert_conformal", rc=rc) - call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - attrList=(/"cen_lon",& - "cen_lat",& - "stdlat1",& - "stdlat2",& - "nx ",& - "ny ",& - "lon1 ",& - "lat1 ",& - "dx ",& - "dy "/), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lon", value=cen_lon(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="cen_lat", value=cen_lat(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="stdlat1", value=stdlat1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="stdlat2", value=stdlat2(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="nx", value=imo(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="ny", value=jmo(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dx", value=dx(grid_id), rc=rc) - call ESMF_AttributeSet(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & - name="dy", value=dy(grid_id), rc=rc) - - end if - end if - enddo ! end wrt_int_state%FBCount ! ! add time Attribute @@ -1768,7 +1646,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) type(write_wrap) :: wrap type(wrt_internal_state),pointer :: wrt_int_state ! - integer :: i,j,n,mype,nolog, grid_id, localPet + integer :: i,j,n,m, mype,nolog, grid_id, localPet ! integer :: nf_hours,nf_seconds,nf_minutes integer :: fcst_seconds @@ -1815,6 +1693,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) real, allocatable :: output_fh(:) logical :: is_restart_bundle, restart_written integer :: tileCount + type(ESMF_Info) :: fcstInfo, wrtInfo + character(len=ESMF_MAXSTR) :: output_grid_name ! !----------------------------------------------------------------------- !*********************************************************************** @@ -1894,6 +1774,23 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) fieldbundle=file_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return +#if 1 + do m=1, wrt_int_state%FBCount + if (trim_regridmethod_suffix(fcstItemNameList(i)) == trim_regridmethod_suffix(FBlist_outfilename(m))) then + + call ESMF_InfoGetFromHost(file_bundle, info=fcstInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_InfoGetFromHost(wrt_int_state%wrtFB(m), info=wrtInfo, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_InfoUpdate(lhs=wrtInfo, rhs=fcstInfo, recursive=.true., overwrite=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! if (lprnt) call print_att_list(wrt_int_state%wrtFB(m), rc) + + end if + end do +#endif ! see whether a "mirror_" FieldBundle exists, i.e. dealing with moving domain that needs updated Regrid() here. call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & itemType=itemType, rc=rc) @@ -2192,43 +2089,125 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) name="grid_id", value=grid_id, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! update lon1/2 and lat1/2 for regional_latlon_moving - if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (wrtFBName(1:18) == 'cubed_sphere_grid_') then + output_grid_name = "cubed_sphere_grid" + else + output_grid_name = output_grid(grid_id) endif - ! update cen_lon/cen_lat, lon1/2 and lat1/2 for rotated_latlon_moving - if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="cen_lon", value=cen_lon(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="cen_lat", value=cen_lat(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lon1", value=lon1(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lat1", value=lat1(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lon2", value=lon2(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! add output grid related attributes, only for history files(bundles), skip restart + if (.not.is_restart_bundle) then + + call ESMF_AttributeAdd(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + attrList=(/"source","grid "/), rc=rc) call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="lat2", value=lat2(grid_id), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif + name="source", value="FV3GFS", rc=rc) + + if (trim(output_grid_name) == 'cubed_sphere_grid') then + + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid", value="cubed_sphere", rc=rc) + + else if (trim(output_grid_name) == 'gaussian_grid') then + + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid", value="gaussian", rc=rc) + call ESMF_AttributeAdd(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + attrList=(/"im","jm"/), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="im", value=imo(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="jm", value=jmo(grid_id), rc=rc) + + else if (trim(output_grid_name) == 'regional_latlon' & + .or. trim(output_grid_name) == 'regional_latlon_moving' & + .or. trim(output_grid_name) == 'global_latlon') then + + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid", value="latlon", rc=rc) + call ESMF_AttributeAdd(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + attrList=(/"lon1","lat1","lon2","lat2","dlon","dlat"/), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dlon", value=dlon(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dlat", value=dlat(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + else if (trim(output_grid_name) == 'rotated_latlon' & + .or. trim(output_grid_name) == 'rotated_latlon_moving') then + + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid", value="rotated_latlon", rc=rc) + call ESMF_AttributeAdd(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + attrList=(/"cen_lon",& + "cen_lat",& + "lon1 ",& + "lat1 ",& + "lon2 ",& + "lat2 ",& + "dlon ",& + "dlat "/), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lon", value=cen_lon(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lat", value=cen_lat(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dlon", value=dlon(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dlat", value=dlat(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon2", value=lon2(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat2", value=lat2(grid_id), rc=rc) + else if (trim(output_grid_name) == 'lambert_conformal') then + + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid", value="lambert_conformal", rc=rc) + call ESMF_AttributeAdd(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + attrList=(/"cen_lon",& + "cen_lat",& + "stdlat1",& + "stdlat2",& + "nx ",& + "ny ",& + "lon1 ",& + "lat1 ",& + "dx ",& + "dy "/), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lon", value=cen_lon(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="cen_lat", value=cen_lat(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="stdlat1", value=stdlat1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="stdlat2", value=stdlat2(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="nx", value=imo(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="ny", value=jmo(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lat1", value=lat1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="lon1", value=lon1(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dx", value=dx(grid_id), rc=rc) + call ESMF_AttributeSet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="dy", value=dy(grid_id), rc=rc) + + end if + + end if ! .not.is_restart_bundle if(step == 1) then file_bundle = wrt_int_state%wrtFB(nbdl) @@ -4614,6 +4593,36 @@ end function trim_suffix !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& !----------------------------------------------------------------------- + subroutine print_att_list(fb, rc) + type(ESMF_FieldBundle), intent(in) :: fb + integer, intent(out) :: rc + + integer :: i + integer :: itemCount + integer :: attCount + character(len=ESMF_MAXSTR) :: fbName, attName + type(ESMF_TypeKind_Flag) :: typekind + + rc = 0 + call ESMF_FieldBundleGet(fb, name=fbName, rc=rc) + + write(0,*)'==== ', trim(fbName) + + call ESMF_AttributeGet(fb, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, count=attCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do i=1, attCount + call ESMF_AttributeGet(fb, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, itemCount=itemCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(0,*) i , trim(attName), typekind + + end do + + end subroutine print_att_list ! end module module_wrt_grid_comp ! diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index ea622369c..b406b6fce 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -1339,6 +1339,11 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) integer :: unit real(kind=8) :: mpi_wtime, tbeg1 ! + integer :: FBCount, i + logical :: isPresent + character(len=esmf_maxstr),allocatable :: itemNameList(:) + type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) + type(ESMF_FieldBundle) :: fcstExportFB !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- @@ -1381,6 +1386,39 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) endif endif + ! update fhzero + call ESMF_StateGet(exportState, itemCount=FBCount, rc=rc) + + allocate (itemNameList(FBCount)) + allocate (itemTypeList(FBCount)) + call ESMF_StateGet(exportState, & + itemNameList=itemNameList, & + itemTypeList=itemTypeList, & + rc=rc) + do i=1, FBcount + if (itemTypeList(i) == ESMF_STATEITEM_FIELDBUNDLE) then + call ESMF_StateGet(exportState, itemName=itemNameList(i), & + fieldbundle=fcstExportFB, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_AttributeGet(fcstExportFB, convention="NetCDF", purpose="FV3", & + name="fhzero", isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (isPresent) then + call ESMF_AttributeSet(fcstExportFB, convention="NetCDF", purpose="FV3", name="fhzero", value=nint(GFS_control%fhzero), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + else + !***### anything but a FieldBundle in the state is unexpected here + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Only FieldBundles supported in fcstState.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + enddo + if (mype == 0) write(*,'(A,I16,A,F16.6)')'PASS: fcstRUN phase 2, n_atmsteps = ', & n_atmsteps,' time is ',mpi_wtime()-tbeg1 ! From d59e80e2ec4aaa68f5c0775fad3bb8beed3d24c1 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 5 Feb 2024 17:44:45 +0000 Subject: [PATCH 6/9] Update to speed uo writing restart files Co-authored-by: Dusan Javic --- io/module_wrt_grid_comp.F90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 615bd3a64..46b667a35 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -3418,11 +3418,13 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_VMGet(vm=vm, mpiCommunicator=wrt_mpi_comm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (petCount > 1) then - call write_restart_netcdf(wrtTileFB, trim(tileFileName), .true., wrt_mpi_comm, localPet, rc) - else + !Restrict writing cubed sphere restart files to use serial I/O due to slowness + ! on WCOOS2 when large number of tasks in the write group is used + !if (petCount > 1) then + ! call write_restart_netcdf(wrtTileFB, trim(tileFileName), .true., wrt_mpi_comm, localPet, rc) + !else call write_restart_netcdf(wrtTileFB, trim(tileFileName), .false., wrt_mpi_comm, localPet, rc) - endif + !endif endif return From e7ccd192e1642d1004cf10e0ca17a30fb7b46517 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Fri, 9 Feb 2024 20:14:21 +0000 Subject: [PATCH 7/9] allow fhzero to be non-integer --- io/fv3atm_history_io.F90 | 5 +++-- io/module_write_internal_state.F90 | 2 +- io/post_fv3.F90 | 13 ++++++------- module_fcst_grid_comp.F90 | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/io/fv3atm_history_io.F90 b/io/fv3atm_history_io.F90 index 7c73fe296..2bb1e8a22 100644 --- a/io/fv3atm_history_io.F90 +++ b/io/fv3atm_history_io.F90 @@ -50,7 +50,8 @@ module fv3atm_history_io_mod integer :: tot_diag_idx = 0 integer :: isco=0,ieco=0,jsco=0,jeco=0,levo=0,num_axes_phys=0 - integer :: fhzero=0, ncld=0, nsoil=0, imp_physics=0, landsfcmdl=0 + integer :: ncld=0, nsoil=0, imp_physics=0, landsfcmdl=0 + real(4) :: fhzero=0. real(4) :: dtp=0 integer,dimension(:), pointer :: nstt => null() integer,dimension(:), pointer :: nstt_vctbl => null() @@ -183,7 +184,7 @@ subroutine history_type_register(hist, Diag, Time, Atm_block, Model, xlon, xlat, hist%jsco = Atm_block%jsc hist%jeco = Atm_block%jec hist%levo = model%levs - hist%fhzero = nint(Model%fhzero) + hist%fhzero = Model%fhzero ! hist%ncld = Model%ncld hist%ncld = Model%imp_physics hist%nsoil = Model%lsoil diff --git a/io/module_write_internal_state.F90 b/io/module_write_internal_state.F90 index 51c422227..0f81fc9c0 100644 --- a/io/module_write_internal_state.F90 +++ b/io/module_write_internal_state.F90 @@ -93,7 +93,7 @@ module write_internal_state logical :: write_dopost !< True if inline post is requested. character(80) :: post_namelist !< File name of the inline post namelist. ! - integer :: fhzero !< Hours between clearing of diagnostic buckets. + real(4) :: fhzero !< Hours between clearing of diagnostic buckets. integer :: ntrac !< Number of tracers. integer :: ncld !< Number of hydrometeors. integer :: nsoil !< Number of soil layers. diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 97962bdd9..e3bd250e3 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -428,7 +428,6 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) if (trim(attName) == 'ncnsto') wrt_int_state%ntrac=varival if (trim(attName) == 'ncld') wrt_int_state%ncld=varival if (trim(attName) == 'nsoil') wrt_int_state%nsoil=varival - if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varival if (trim(attName) == 'imp_physics') wrt_int_state%imp_physics=varival endif else if (typekind==ESMF_TYPEKIND_R4) then @@ -437,9 +436,9 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) name=trim(attName), value=varr4val, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out - if (trim(attName) == 'dtp') then - wrt_int_state%dtp=varr4val - endif + if (trim(attName) == 'dtp') wrt_int_state%dtp=varr4val + if (trim(attName) == 'fhzero') wrt_int_state%fhzero=varr4val +! print *,'in post_fv3, fhzero=',wrt_int_state%fhzero else if(n>1) then if(trim(attName) =="ak") then if(allocated(wrt_int_state%ak)) deallocate(wrt_int_state%ak) @@ -628,15 +627,15 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) spval = 9.99e20 ! ! nems gfs has zhour defined - tprec = float(wrt_int_state%fhzero) + tprec = wrt_int_state%fhzero tclod = tprec trdlw = tprec trdsw = tprec tsrfc = tprec tmaxmin = tprec td3d = tprec -! if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & -! 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm + if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & + 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm ! write(6,*) 'maptype and gridtype is ', maptype,gridtype ! diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index b406b6fce..b1bd94de0 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -1406,7 +1406,7 @@ subroutine fcst_run_phase_2(fcst_comp, importState, exportState,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (isPresent) then - call ESMF_AttributeSet(fcstExportFB, convention="NetCDF", purpose="FV3", name="fhzero", value=nint(GFS_control%fhzero), rc=rc) + call ESMF_AttributeSet(fcstExportFB, convention="NetCDF", purpose="FV3", name="fhzero", value=GFS_control%fhzero, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif else From 2a764776dec913c88f8b5246ed7e092586d23e08 Mon Sep 17 00:00:00 2001 From: Jun Wang Date: Tue, 5 Mar 2024 08:29:50 -0600 Subject: [PATCH 8/9] address comments --- atmos_model.F90 | 20 ++++++++++---------- io/module_wrt_grid_comp.F90 | 3 +-- io/post_fv3.F90 | 4 ++-- 3 files changed, 13 insertions(+), 14 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 49a54d9d6..cc5efe658 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -538,7 +538,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) integer :: tile_num integer :: isc, iec, jsc, jec real(kind=GFS_kind_phys) :: dt_phys - logical :: p_hydro, hydro, tmpflag + logical :: p_hydro, hydro, tmpflag_fhzero logical, save :: block_message = .true. type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) @@ -790,15 +790,15 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- the bucket, but the restart time. if( GFS_Control%fhzero_array(1) > 0. ) then fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - tmpflag = .false. + tmpflag_fhzero= .false. if( GFS_Control%fhzero_array(i) > 0.) then if( i == 1 ) then - if( sec <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag = .true. + if( sec <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true. else if( i > 1 ) then if( sec > GFS_Control%fhzero_fhour(i-1)*3600. .and. sec <=GFS_Control%fhzero_fhour(i)*3600. ) & - tmpflag = .true. + tmpflag_fhzero = .true. endif - if( tmpflag ) then + if( tmpflag_fhzero ) then GFS_Control%fhzero = GFS_Control%fhzero_array(i) if( GFS_Control%fhzero > 0) then sec_lastfhzerofh = (int(sec/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600 @@ -975,7 +975,7 @@ subroutine update_atmos_model_state (Atmos, rc) !--- local variables integer :: i, localrc, sec_lastfhzerofh integer :: isec, seconds, isec_fhzero - logical :: tmpflag + logical :: tmpflag_fhzero real(kind=GFS_kind_phys) :: time_int, time_intfull ! if (present(rc)) rc = ESMF_SUCCESS @@ -1030,15 +1030,15 @@ subroutine update_atmos_model_state (Atmos, rc) !--- find current fhzero if( GFS_Control%fhzero_array(1) > 0. ) then fhzero_loop: do i=1,size(GFS_Control%fhzero_array) - tmpflag = .false. + tmpflag_fhzero = .false. if( GFS_Control%fhzero_array(i) > 0.) then if( i == 1 ) then - if( seconds <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag = .true. + if( seconds <= GFS_Control%fhzero_fhour(i)*3600. ) tmpflag_fhzero = .true. else if( i > 1 ) then if( seconds > GFS_Control%fhzero_fhour(i-1)*3600. .and. seconds <= GFS_Control%fhzero_fhour(i)*3600. ) & - tmpflag = .true. + tmpflag_fhzero = .true. endif - if( tmpflag) then + if( tmpflag_fhzero) then GFS_Control%fhzero = GFS_Control%fhzero_array(i) if( GFS_Control%fhzero > 0) then sec_lastfhzerofh = (int(seconds/3600.)/int(GFS_Control%fhzero))*int(GFS_Control%fhzero)*3600 diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 3cc8cfb6e..6a3fcfa13 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -1776,7 +1776,6 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) fieldbundle=file_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -#if 1 do m=1, wrt_int_state%FBCount if (trim_regridmethod_suffix(fcstItemNameList(i)) == trim_regridmethod_suffix(FBlist_outfilename(m))) then @@ -1792,7 +1791,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) end if end do -#endif + ! see whether a "mirror_" FieldBundle exists, i.e. dealing with moving domain that needs updated Regrid() here. call ESMF_StateGet(imp_state_write, itemName="mirror_"//trim(fcstItemNameList(i)), & itemType=itemType, rc=rc) diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 301b8bd54..e74a1947e 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -634,8 +634,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) tsrfc = tprec tmaxmin = tprec td3d = tprec - if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & - 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm +! if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & +! 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm ! write(6,*) 'maptype and gridtype is ', maptype,gridtype ! From 499d3d375c389ec1d855176e35979007f1b95e56 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 9 May 2024 13:10:11 +0000 Subject: [PATCH 9/9] Move ESMF_InfoBroadcast call outside ESMF_VMEpochEnter/ESMF_VMEpochExit section to avoid hanging --- fv3_cap.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index e4074422f..20c2bcc7a 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1177,6 +1177,15 @@ subroutine ModelAdvance_phase2(gcomp, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if + enddo + + call ESMF_VMEpochExit(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_TraceRegionExit("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) + + do j=1, FBCount + ! Update fcstFB attributes from fcst PEs to all PEs in this VM ! This is needed in case some attributes are updated during run time call ESMF_FieldBundleGet(fcstFB(j), name=fb_name, rc=rc) @@ -1190,11 +1199,6 @@ subroutine ModelAdvance_phase2(gcomp, rc) enddo - call ESMF_VMEpochExit(rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_TraceRegionExit("ESMF_VMEpoch:fcstFB->wrtFB", rc=rc) - call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return