diff --git a/atmos_model.F90 b/atmos_model.F90 index a2ca32a75..92fa59742 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -533,12 +533,12 @@ 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 real(kind=GFS_kind_phys) :: dt_phys - logical :: p_hydro, hydro + logical :: p_hydro, hydro, tmpflag_fhzero logical, save :: block_message = .true. type(GFS_init_type) :: Init_parm integer :: bdat(8), cdat(8) @@ -789,8 +789,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. - 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( GFS_Control%fhzero_array(1) > 0. ) then + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + tmpflag_fhzero= .false. + if( GFS_Control%fhzero_array(i) > 0.) then + if( i == 1 ) then + 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_fhzero = .true. + endif + 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 + else + sec_lastfhzerofh = 0 + endif + endif + endif + 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-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 @@ -949,8 +974,9 @@ 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 + logical :: tmpflag_fhzero real(kind=GFS_kind_phys) :: time_int, time_intfull ! if (present(rc)) rc = ESMF_SUCCESS @@ -1001,16 +1027,38 @@ 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 + + !--- find current fhzero + if( GFS_Control%fhzero_array(1) > 0. ) then + fhzero_loop: do i=1,size(GFS_Control%fhzero_array) + tmpflag_fhzero = .false. + if( GFS_Control%fhzero_array(i) > 0.) then + if( i == 1 ) then + 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_fhzero = .true. + endif + 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 + else + sec_lastfhzerofh = 0 + endif + endif + endif + enddo fhzero_loop else - if (mod(isec,nint(3600*GFS_control%fhzero)) == 0) diag_time = Atmos%Time + sec_lastfhzerofh = 0 endif - call diag_send_complete_instant (Atmos%Time) + if (mpp_pe() == mpp_root_pe()) print *,'in atmos_model update, fhzero=',GFS_Control%fhzero, 'fhour=',seconds/3600.,sec_lastfhzerofh/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 - sec_lastfhzerofh,nint(GFS_Control%fhzero*3600.)) == 0) diag_time = Atmos%Time +! 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) !--- 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 31f48bf5d..40c33cfc5 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -710,7 +710,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 @@ -3327,6 +3329,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 @@ -3983,9 +3987,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, fhcyc, thermodyn_id, sfcpress_id, & !--- coupling parameters cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & cplchm, cpllnd, cpllnd2atm, cpl_imp_mrg, cpl_imp_dbg, & @@ -4196,6 +4200,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 @@ -5621,6 +5630,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.' @@ -6414,6 +6427,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 diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 713460fe3..20c2bcc7a 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -1114,6 +1114,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 @@ -1182,6 +1184,21 @@ subroutine ModelAdvance_phase2(gcomp, rc) 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) + 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_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 diff --git a/io/fv3atm_history_io.F90 b/io/fv3atm_history_io.F90 index 7171aa673..6fe537e04 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,num_axes_phys=0 - integer :: fhzero=0, ncld=0, nsoil=0, nsoil_lsm=0, imp_physics=0, landsfcmdl=0 + integer :: ncld=0, nsoil=0, nsoil_lsm=0, imp_physics=0, landsfcmdl=0 + real(4) :: fhzero=0. real(4) :: dtp=0 integer,dimension(:), pointer :: levo => null() integer,dimension(:), pointer :: nstt => null() @@ -183,7 +184,7 @@ subroutine history_type_register(hist, Diag, Time, Atm_block, Model, xlon, xlat, hist%ieco = Atm_block%iec hist%jsco = Atm_block%jsc hist%jeco = Atm_block%jec - 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/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 5a3945714..af468c57e 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -80,6 +80,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 ! !----------------------------------------------------------------------- @@ -196,7 +197,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 @@ -215,8 +216,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 !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- @@ -1161,129 +1162,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 @@ -1785,7 +1663,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 @@ -1832,6 +1710,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 ! !----------------------------------------------------------------------- !*********************************************************************** @@ -1911,6 +1791,22 @@ 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 + 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 + ! 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) @@ -2209,43 +2105,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) @@ -3457,11 +3435,13 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_VMGet(vm=vm, mpiCommunicator=wrt_mpi_comm%mpi_val, 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 @@ -4649,6 +4629,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/io/post_fv3.F90 b/io/post_fv3.F90 index 1a679f18d..5d222497e 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -430,7 +430,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 @@ -439,9 +438,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) @@ -630,7 +629,7 @@ 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 diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 07f059023..27cdf955f 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -1363,6 +1363,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 !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- @@ -1405,6 +1410,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=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 !