From 485c476f5861016d8361c95af4334d44438571d7 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 12 Apr 2023 23:51:28 +0000 Subject: [PATCH 1/8] Update .gitmodules --- .gitmodules | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 22c723ac1..f87d49db1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,9 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere - branch = dev/emc + #url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + #branch = dev/emc + url = https://github.com/DusanJovic-NOAA/GFDL_atmos_cubed_sphere + branch = multiple_domains_quilting_restart [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework From 69a59ae06cb4892b8eba21e102d465f9f9b67832 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 13 Apr 2023 12:21:07 +0000 Subject: [PATCH 2/8] Enable writing restart files for multiple domains (nests) --- atmos_cubed_sphere | 2 +- io/module_write_internal_state.F90 | 1 - io/module_wrt_grid_comp.F90 | 93 +++++++++++++++++++++++------- 3 files changed, 72 insertions(+), 24 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 9d5bed8e9..1fc0452a9 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 9d5bed8e932a188d714c8c8a770e44801dab4750 +Subproject commit 1fc0452a911db7bc3366ff8b2f519e708c1be816 diff --git a/io/module_write_internal_state.F90 b/io/module_write_internal_state.F90 index ef7e69f6b..9ab449c0e 100644 --- a/io/module_write_internal_state.F90 +++ b/io/module_write_internal_state.F90 @@ -48,7 +48,6 @@ module write_internal_state !*** file bundle for output !-------------------------- integer :: FBCount - character(128),dimension(:),allocatable :: wrtFB_names ! !----------------------------------------------------------------------- !*** THE OUTPUT FILE diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 8d6c44b17..78831406d 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -77,6 +77,7 @@ module module_wrt_grid_comp type(ESMF_FieldBundle) :: gridFB integer :: FBCount character(len=esmf_maxstr),allocatable :: fcstItemNameList(:) + logical :: top_parent_is_global ! !----------------------------------------------------------------------- REAL(KIND=8) :: btim,btim0 @@ -207,7 +208,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG integer :: grid_id - logical :: top_parent_is_global ! !----------------------------------------------------------------------- !*********************************************************************** @@ -811,7 +811,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! if (lprnt) write(0,*)'wrt_initialize_p1: FBCount=',FBCount, ' from imp_state_write' allocate(fcstItemNameList(FBCount), fcstItemTypeList(FBCount)) - allocate(wrt_int_state%wrtFB_names(FBCount)) ! this array should be allocated as wrt_int_state%FBCount long not FBCount allocate(outfilename(2000,FBCount)) outfilename = '' @@ -1003,10 +1002,22 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! !loop over all items in the imp_state_write and count output FieldBundles - ! if (lprnt) write(0,*)'wrt_initialize_p1: before get_outfile FBCount =', FBCount + ! if (lprnt) then + ! write(*,*)'wrt_initialize_p1: FBCount ', FBCount + ! do n=1, FBCount + ! write(*,*)'wrt_initialize_p1: ', n, trim(fcstItemNameList(n)) + ! enddo + ! endif + call get_outfile(FBCount, outfilename, FBlist_outfilename, noutfile) wrt_int_state%FBCount = noutfile - ! if (lprnt) write(0,*)'wrt_initialize_p1: wrt_int_state%FBCount = noutfile ', wrt_int_state%FBCount, noutfile + + ! if (lprnt) then + ! write(*,*)'wrt_initialize_p1: wrt_int_state%FBCount ', wrt_int_state%FBCount + ! do i=1, wrt_int_state%FBCount + ! write(*,*)'wrt_initialize_p1: ', i, trim(FBlist_outfilename(i)) + ! enddo + ! endif ! !create output field bundles @@ -1015,8 +1026,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, do i=1, wrt_int_state%FBCount - wrt_int_state%wrtFB_names(i) = trim(FBlist_outfilename(i)) - wrt_int_state%wrtFB(i) = ESMF_FieldBundleCreate(name=trim(wrt_int_state%wrtFB_names(i)), rc=rc) + wrt_int_state%wrtFB(i) = ESMF_FieldBundleCreate(name=trim(FBlist_outfilename(i)), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! if (lprnt) write(0,*)'wrt_initialize_p1: created wrtFB ',i, ' with name ', trim(wrt_int_state%wrtFB_names(i)) @@ -1030,7 +1040,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! if (lprnt) write(0,*)'wrt_initialize_p1: got forecast bundle ', "output_"//trim(fcstItemNameList(n)) ! if (lprnt) write(0,*)'wrt_initialize_p1: is ', trim(fcstItemNameList(n)), ' == ', trim(FBlist_outfilename(i)) - if( index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) == 1 ) then + if (trim_regridmethod_suffix(fcstItemNameList(n)) == trim_regridmethod_suffix(FBlist_outfilename(i))) then ! ! copy the fcstfield bundle Attributes to the output field bundle ! if (lprnt) write(0,*)'wrt_initialize_p1: copy atts/fields from ', "output_"//trim(fcstItemNameList(n)), ' to ', trim(wrt_int_state%wrtFB_names(i)) @@ -1071,11 +1081,13 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - enddo + enddo ! fieldCount deallocate(fcstField, fieldnamelist) endif ! index(trim(fcstItemNameList(n)),trim(FBlist_outfilename(i))) + enddo ! end FBCount + ! add output grid related attributes call ESMF_AttributeAdd(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & @@ -1145,7 +1157,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, 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(grid_id)) /= 'rotated_latlon_moving') then + if (trim(output_grid(grid_id)) /= '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", & @@ -1193,7 +1205,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, end if - enddo ! end FBCount enddo ! end wrt_int_state%FBCount ! ! add time Attribute @@ -1674,6 +1685,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) character(40) :: cfhour, cform character(20) :: time_iso character(15) :: time_restart + character(15) :: tile_id ! type(ESMF_Grid) :: grid type(ESMF_Info) :: info @@ -2033,10 +2045,11 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! if (lprnt) write(0,*)'wrt_run: loop over wrt_int_state%FBCount ',wrt_int_state%FBCount, ' nfhour ', nfhour, ' cdate ', cdate(1:6) file_loop_all: do nbdl=1, wrt_int_state%FBCount - ! if (lprnt) write(0,*)'wrt_run: nbdl = ',nbdl, ' fb name ',trim(wrt_int_state%wrtFB_names(nbdl)) + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), name=wrtFBName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return is_restart_bundle = .false. - if (wrt_int_state%wrtFB_names(nbdl)(1:8) == 'restart_') then + if (wrtFBName(1:8) == 'restart_') then is_restart_bundle = .true. if (.not.(ANY(frestart(:) == fcst_seconds))) cycle else @@ -2137,7 +2150,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) write(time_restart,'(I4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') cdate(1:6) ! strip leading 'restart_' from a bundle name and replace it with a directory name 'RESTART/' to create actual file name - filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrt_int_state%wrtFB_names(nbdl)(9:))//'.nc' + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.nc' ! I hate this kind of inconsistencies ! If it's a restart bundle and the output grid is not cubed sphere and the output restart file is @@ -2145,19 +2158,23 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! As opposed to physics restart files (phy_data, sfc_data) which do not have 'tile1' appended. ! Why can't we have consistent naming? - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGet(grid, tileCount=tileCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (tileCount == 1) then ! non cubed sphere restart bundles - if (wrt_int_state%wrtFB_names(nbdl)(9:11) == 'fv_') then ! 'dynamics' restart bundles, append 'tile1' - filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrt_int_state%wrtFB_names(nbdl)(9:))//'.tile1'//'.nc' + if (grid_id > 1) then + if (top_parent_is_global) then + write(tile_id,'(I0)') 6 + grid_id - 1 + else + write(tile_id,'(I0)') grid_id + endif + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile'//trim(tile_id)//'.nc' + else + if (.not. top_parent_is_global) then ! non cubed sphere restart bundles + if (wrtFBName(9:11) == 'fv_') then ! 'dynamics' restart bundles, append 'tile1' + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile1'//'.nc' + endif endif endif else ! history bundle - filename = trim(wrt_int_state%wrtFB_names(nbdl))//'f'//trim(cfhour)//'.nc' + filename = trim(wrtFBName)//'f'//trim(cfhour)//'.nc' endif if(mype == lead_write_task) print *,'in wrt run,filename= ',nbdl,trim(filename) @@ -4388,6 +4405,38 @@ subroutine get_outfile(nfl, filename, outfile_name, noutfile) enddo end subroutine get_outfile + + pure function trim_regridmethod_suffix(string) result(trimmed_string) + character(len=*), intent(in) :: string + character(len=:), allocatable :: trimmed_string + + trimmed_string = trim_suffix(trim(string), '_bilinear') + trimmed_string = trim_suffix(trimmed_string,'_patch') + trimmed_string = trim_suffix(trimmed_string,'_nearest_stod') + trimmed_string = trim_suffix(trimmed_string,'_nearest_dtos') + trimmed_string = trim_suffix(trimmed_string,'_conserve') + + end function trim_regridmethod_suffix + + pure function trim_suffix(string, suffix) result(trimmed_string) + character(len=*), intent(in) :: string, suffix + character(len=:), allocatable :: trimmed_string + integer :: suffix_length, string_length + + suffix_length = len(suffix) + string_length = len(string) + + if (string_length >= suffix_length) then + if (string(string_length-suffix_length+1:string_length) == suffix) then + trimmed_string = string(1:string_length-suffix_length) + else + trimmed_string = string + endif + else + trimmed_string = string + endif + + end function trim_suffix ! !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& From f60fb8c84bf1f0f9cc932392c799df6bf834ea07 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Tue, 25 Apr 2023 12:21:53 +0000 Subject: [PATCH 3/8] Write log.atm.inlinepost.f??? file after inline post --- io/module_wrt_grid_comp.F90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 038c1efcc..db7e6b0e9 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2013,6 +2013,12 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) endif enddo wend = MPI_Wtime() + 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 fv3gfs fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + close(nolog) + endif if (lprnt) then write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual inline post Time is ',wend-wbeg & ,' at Fcst ',nf_hours,':',nf_minutes @@ -2312,7 +2318,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !** write out log file ! if (mype == lead_write_task) then - open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') + open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') write(nolog,100)nfhour,idate(1:6) 100 format(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x)) close(nolog) From 61860840154f841aee8befbd705a611696aa2ea3 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Tue, 25 Apr 2023 12:55:13 +0000 Subject: [PATCH 4/8] Write output files in two pheses, first history then restarts --- io/module_wrt_grid_comp.F90 | 466 ++++++++++++++++++------------------ 1 file changed, 233 insertions(+), 233 deletions(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index db7e6b0e9..6ad048553 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -1677,6 +1677,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! integer :: nbdl, cdate(6), ndig, nnnn integer :: step=1 + integer :: out_phase ! logical :: opened logical :: lmask_fields @@ -2020,7 +2021,7 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) close(nolog) endif if (lprnt) then - write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual inline post Time is ',wend-wbeg & + write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual inline post time is ',wend-wbeg & ,' at Fcst ',nf_hours,':',nf_minutes endif #else @@ -2049,290 +2050,289 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if ( (wrt_int_state%output_history .and. ANY(nint(output_fh(:)*3600.0) == fcst_seconds)) .or. ANY(frestart(:) == fcst_seconds) ) then ! if (lprnt) write(0,*)'wrt_run: loop over wrt_int_state%FBCount ',wrt_int_state%FBCount, ' nfhour ', nfhour, ' cdate ', cdate(1:6) - file_loop_all: do nbdl=1, wrt_int_state%FBCount + two_phase_loop: do out_phase = 1, 2 + file_loop_all: do nbdl=1, wrt_int_state%FBCount - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), name=wrtFBName, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), name=wrtFBName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__,file=__FILE__)) return - is_restart_bundle = .false. - if (wrtFBName(1:8) == 'restart_') then - is_restart_bundle = .true. - if (.not.(ANY(frestart(:) == fcst_seconds))) cycle - else - if (.not.(wrt_int_state%output_history .and. ANY(nint(output_fh(:)*3600.0) == fcst_seconds))) cycle - endif + is_restart_bundle = .false. + if (wrtFBName(1:8) == 'restart_') then + is_restart_bundle = .true. + if (.not.(ANY(frestart(:) == fcst_seconds))) cycle + else + if (.not.(wrt_int_state%output_history .and. ANY(nint(output_fh(:)*3600.0) == fcst_seconds))) cycle + endif - ! get grid_id - call ESMF_AttributeGet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & - name="grid_id", value=grid_id, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (out_phase == 1 .and. is_restart_bundle) cycle + if (out_phase == 2 .and. .not.is_restart_bundle) cycle - ! 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) + ! get grid_id + call ESMF_AttributeGet(wrt_int_state%wrtFB(nbdl), convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - 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 - 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 + ! 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 + endif - if(step == 1) then - file_bundle = wrt_int_state%wrtFB(nbdl) - 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 + 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 - ! FIXME map nbdl to [1:num_files], only used for output_file - nnnn = mod(nbdl-1, num_files) + 1 - - ! set default chunksizes for netcdf output - ! (use MPI decomposition size). - ! if chunksize parameter set to negative value, - ! netcdf library default is used. - if (output_file(nnnn)(1:6) == 'netcdf') then - if (ichunk2d(grid_id) == 0) then - if( wrt_int_state%mype == 0 ) & - ichunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 - call mpi_bcast(ichunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) - endif - if (jchunk2d(grid_id) == 0) then - if( wrt_int_state%mype == 0 ) & - jchunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 - call mpi_bcast(jchunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) - endif - if (ichunk3d(grid_id) == 0) then - if( wrt_int_state%mype == 0 ) & - ichunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 - call mpi_bcast(ichunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) - endif - if (jchunk3d(grid_id) == 0) then - if( wrt_int_state%mype == 0 ) & - jchunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 - call mpi_bcast(jchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) - endif - if (kchunk3d(grid_id) == 0 .and. nbdl == 1) then - if( wrt_int_state%mype == 0 ) then - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=wrtGrid) - call ESMF_AttributeGet(wrtGrid, convention="NetCDF", purpose="FV3", & - attnestflag=ESMF_ATTNEST_OFF, name='pfull', & - itemCount=kchunk3d(grid_id), rc=rc) - endif - call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) - endif - if (wrt_int_state%mype == 0) then - print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) - print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) - endif - endif + if(step == 1) then + file_bundle = wrt_int_state%wrtFB(nbdl) + endif + + ! FIXME map nbdl to [1:num_files], only used for output_file + nnnn = mod(nbdl-1, num_files) + 1 + + ! set default chunksizes for netcdf output + ! (use MPI decomposition size). + ! if chunksize parameter set to negative value, + ! netcdf library default is used. + if (output_file(nnnn)(1:6) == 'netcdf') then + if (ichunk2d(grid_id) == 0) then + if( wrt_int_state%mype == 0 ) & + ichunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 + call mpi_bcast(ichunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) + endif + if (jchunk2d(grid_id) == 0) then + if( wrt_int_state%mype == 0 ) & + jchunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 + call mpi_bcast(jchunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) + endif + if (ichunk3d(grid_id) == 0) then + if( wrt_int_state%mype == 0 ) & + ichunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 + call mpi_bcast(ichunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) + endif + if (jchunk3d(grid_id) == 0) then + if( wrt_int_state%mype == 0 ) & + jchunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 + call mpi_bcast(jchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) + endif + if (kchunk3d(grid_id) == 0 .and. nbdl == 1) then + if( wrt_int_state%mype == 0 ) then + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=wrtGrid) + call ESMF_AttributeGet(wrtGrid, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, name='pfull', & + itemCount=kchunk3d(grid_id), rc=rc) + endif + call mpi_bcast(kchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) + endif + if (wrt_int_state%mype == 0) then + print *,'ichunk2d,jchunk2d',ichunk2d(grid_id),jchunk2d(grid_id) + print *,'ichunk3d,jchunk3d,kchunk3d',ichunk3d(grid_id),jchunk3d(grid_id),kchunk3d(grid_id) + endif + endif - if (is_restart_bundle) then - write(time_restart,'(I4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') cdate(1:6) + if (is_restart_bundle) then + write(time_restart,'(I4,I2.2,I2.2,".",I2.2,I2.2,I2.2)') cdate(1:6) - ! strip leading 'restart_' from a bundle name and replace it with a directory name 'RESTART/' to create actual file name - filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.nc' + ! strip leading 'restart_' from a bundle name and replace it with a directory name 'RESTART/' to create actual file name + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.nc' - ! I hate this kind of inconsistencies - ! If it's a restart bundle and the output grid is not cubed sphere and the output restart file is - ! from dycore (ie. fv_core, fv_srf_wnd, fv_tracer) append 'tile1' to the end of the file name. - ! As opposed to physics restart files (phy_data, sfc_data) which do not have 'tile1' appended. - ! Why can't we have consistent naming? + ! I hate this kind of inconsistencies + ! If it's a restart bundle and the output grid is not cubed sphere and the output restart file is + ! from dycore (ie. fv_core, fv_srf_wnd, fv_tracer) append 'tile1' to the end of the file name. + ! As opposed to physics restart files (phy_data, sfc_data) which do not have 'tile1' appended. + ! Why can't we have consistent naming? - if (grid_id > 1) then - if (top_parent_is_global) then - write(tile_id,'(I0)') 6 + grid_id - 1 + if (grid_id > 1) then + if (top_parent_is_global) then + write(tile_id,'(I0)') 6 + grid_id - 1 + else + write(tile_id,'(I0)') grid_id + endif + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile'//trim(tile_id)//'.nc' else - write(tile_id,'(I0)') grid_id - endif - filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile'//trim(tile_id)//'.nc' - else - if (.not. top_parent_is_global) then ! non cubed sphere restart bundles - if (wrtFBName(9:11) == 'fv_') then ! 'dynamics' restart bundles, append 'tile1' - filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile1'//'.nc' + if (.not. top_parent_is_global) then ! non cubed sphere restart bundles + if (wrtFBName(9:11) == 'fv_') then ! 'dynamics' restart bundles, append 'tile1' + filename = 'RESTART/'//trim(time_restart)//'.'//trim(wrtFBName(9:))//'.tile1'//'.nc' + endif endif endif - endif - - else ! history bundle - filename = trim(wrtFBName)//'f'//trim(cfhour)//'.nc' - endif - if(mype == lead_write_task) print *,'in wrt run,filename= ',nbdl,trim(filename) -! -! set the time Attribute on the grid to carry it into the lower levels - call ESMF_FieldBundleGet(file_bundle, grid=fbgrid, rc=rc) + else ! history bundle + filename = trim(wrtFBName)//'f'//trim(cfhour)//'.nc' + endif + if(mype == lead_write_task) print *,'in wrt run,filename= ',nbdl,trim(filename) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! + ! set the time Attribute on the grid to carry it into the lower levels + call ESMF_FieldBundleGet(file_bundle, grid=fbgrid, rc=rc) - call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & - name="time", value=nfhour, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & + name="time", value=nfhour, rc=rc) - call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & - name="time_iso", value=trim(time_iso), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & + name="time_iso", value=trim(time_iso), rc=rc) -!*** write out grid bundle: -! Provide log message indicating which wrtComp is active - call ESMF_LogWrite("before Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + !*** write out grid bundle: + ! Provide log message indicating which wrtComp is active + call ESMF_LogWrite("before Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) - if (trim(output_file(nnnn)) == 'netcdf') then - use_parallel_netcdf = .false. - else if (trim(output_file(nnnn)) == 'netcdf_parallel') then - use_parallel_netcdf = .true. - else - call ESMF_LogWrite("wrt_run: Unknown output_file",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - wbeg = MPI_Wtime() + if (trim(output_file(nnnn)) == 'netcdf') then + use_parallel_netcdf = .false. + else if (trim(output_file(nnnn)) == 'netcdf_parallel') then + use_parallel_netcdf = .true. + else + call ESMF_LogWrite("wrt_run: Unknown output_file",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif - if (is_restart_bundle) then ! restart bundle - ! restart bundles are always on forecast grid, either cubed sphere or regional/nest + wbeg = MPI_Wtime() - call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGet(grid, tileCount=tileCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (is_restart_bundle) then ! restart bundle + ! restart bundles are always on forecast grid, either cubed sphere or regional/nest - if (tileCount == 6) then ! restart bundle is on cubed sphere - call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & - convention="NetCDF", purpose="FV3", & - status=ESMF_FILESTATUS_REPLACE, & - state=stateGridFB, comps=compsGridFB,rc=rc) + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(nbdl), grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & - filename=trim(filename), convention="NetCDF", & - purpose="FV3", status=ESMF_FILESTATUS_OLD, & - timeslice=step, state=optimize(nbdl)%state, & - comps=optimize(nbdl)%comps, rc=rc) + call ESMF_GridGet(grid, tileCount=tileCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else - call write_restart_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & - .true., wrt_mpi_comm, wrt_int_state%mype, & - rc) - endif ! cubed sphere vs. regional/nest write grid - else ! history bundle - if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then + if (tileCount == 6) then ! restart bundle is on cubed sphere + call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & + convention="NetCDF", purpose="FV3", & + status=ESMF_FILESTATUS_REPLACE, & + state=stateGridFB, comps=compsGridFB,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(output_file(nnnn)) == 'netcdf_parallel') then - call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & - .true., wrt_mpi_comm,wrt_int_state%mype, & - grid_id,rc) - else - call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & - convention="NetCDF", purpose="FV3", & - status=ESMF_FILESTATUS_REPLACE, & - state=stateGridFB, comps=compsGridFB,rc=rc) + call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & + filename=trim(filename), convention="NetCDF", & + purpose="FV3", status=ESMF_FILESTATUS_OLD, & + timeslice=step, state=optimize(nbdl)%state, & + comps=optimize(nbdl)%comps, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + call write_restart_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + .true., wrt_mpi_comm, wrt_int_state%mype, & + rc) + endif ! cubed sphere vs. regional/nest write grid - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else ! history bundle + if (trim(output_grid(grid_id)) == 'cubed_sphere_grid') then - call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & - filename=trim(filename), convention="NetCDF", & - purpose="FV3", status=ESMF_FILESTATUS_OLD, & - timeslice=step, state=optimize(nbdl)%state, & - comps=optimize(nbdl)%comps, rc=rc) + if (trim(output_file(nnnn)) == 'netcdf_parallel') then + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + .true., wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) + else + call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & + convention="NetCDF", purpose="FV3", & + status=ESMF_FILESTATUS_REPLACE, & + state=stateGridFB, comps=compsGridFB,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - end if + call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & + filename=trim(filename), convention="NetCDF", & + purpose="FV3", status=ESMF_FILESTATUS_OLD, & + timeslice=step, state=optimize(nbdl)%state, & + comps=optimize(nbdl)%comps, rc=rc) - else if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & - trim(output_grid(grid_id)) == 'global_latlon') then + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & - use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & - grid_id,rc) + end if - else if (trim(output_grid(grid_id)) == 'regional_latlon' .or. & - trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving' .or. & - trim(output_grid(grid_id)) == 'lambert_conformal') then + else if (trim(output_grid(grid_id)) == 'gaussian_grid' .or. & + trim(output_grid(grid_id)) == 'global_latlon') then - !mask fields according to sfc pressure - if( .not. lmask_fields ) then - call mask_fields(file_bundle,rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) - if (nbits(grid_id) /= 0) then - call ESMF_LogWrite("wrt_run: lossy compression is not supported for regional grids",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + else if (trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'lambert_conformal') then - call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & - use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & - grid_id,rc) + !mask fields according to sfc pressure + if( .not. lmask_fields ) then + call mask_fields(file_bundle,rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif - else ! unknown output_grid + if (nbits(grid_id) /= 0) then + call ESMF_LogWrite("wrt_run: lossy compression is not supported for regional grids",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if - call ESMF_LogWrite("wrt_run: Unknown output_grid",ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + call write_netcdf(wrt_int_state%wrtFB(nbdl),trim(filename), & + use_parallel_netcdf, wrt_mpi_comm,wrt_int_state%mype, & + grid_id,rc) - endif - endif ! restart or history bundle - wend = MPI_Wtime() - if (lprnt) then - write(*,'(A48,A,F10.5,A,I4.2,A,I2.2,1X,A)')trim(filename),' Write Time is ',wend-wbeg & - ,' at Fcst ',NF_HOURS,':',NF_MINUTES - endif + else ! unknown output_grid - enddo file_loop_all + call ESMF_LogWrite("wrt_run: Unknown output_grid",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) -! end output history + endif + endif ! restart or history bundle + wend = MPI_Wtime() + if (lprnt) then + write(*,'(A56,A,F10.5,A,I4.2,A,I2.2,1X,A)') trim(filename),' write time is ',wend-wbeg & + ,' at fcst ',NF_HOURS,':',NF_MINUTES + endif + + enddo file_loop_all + + 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 fv3gfs fhour=',f10.3,2x,6(i4,2x))") nfhour, idate(1:6) + close(nolog) + endif + enddo two_phase_loop endif ! if ( wrt_int_state%output_history ) -! -!** write out log file -! - if (mype == lead_write_task) then - open(newunit=nolog,file='log.atm.f'//trim(cfhour),form='FORMATTED') - write(nolog,100)nfhour,idate(1:6) -100 format(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x)) - close(nolog) - endif -! -!----------------------------------------------------------------------- -! + call ESMF_VMBarrier(VM, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! + write_run_tim = MPI_Wtime() - tbeg -! + IF (lprnt) THEN - write(*,'(A48,A,F10.5,A,I4.2,A,I2.2,1X,A)')'------- total',' Write Time is ',write_run_tim & + write(*,'(A56,A,F10.5,A,I4.2,A,I2.2,1X,A)')'------- total',' write time is ',write_run_tim & ,' at Fcst ',NF_HOURS,':',NF_MINUTES ENDIF ! From ce069764e19c6ab80cb13458bf3b48e651d3adbe Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Thu, 27 Apr 2023 12:19:49 +0000 Subject: [PATCH 5/8] Fix movable nests quilting restart --- fv3_cap.F90 | 9 +- io/module_wrt_grid_comp.F90 | 298 +++++++++++++++++++----------------- 2 files changed, 168 insertions(+), 139 deletions(-) diff --git a/fv3_cap.F90 b/fv3_cap.F90 index bb30c6c95..7b3ab2eba 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -211,6 +211,8 @@ subroutine InitializeAdvertise(gcomp, rc) logical :: use_saved_routehandles, rh_file_exist logical :: fieldbundle_is_restart = .false. + integer :: sloc + type(ESMF_StaggerLoc) :: staggerloc ! !------------------------------------------------------------------------ ! @@ -634,7 +636,12 @@ subroutine InitializeAdvertise(gcomp, rc) dstGrid(j,i) = grid ! loop over all the mirror fields and set the balanced mirror Grid do ii=1, fieldCount - call ESMF_FieldEmptySet(fieldList(ii), grid=grid, rc=rc) + call ESMF_InfoGetFromHost(fieldList(ii), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGet(info, key="staggerloc", value=sloc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + staggerloc = sloc ! convert integer into StaggerLoc_Flag + call ESMF_FieldEmptySet(fieldList(ii), grid=grid, staggerloc=staggerloc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo ! clean-up diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 6ad048553..351f99047 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -173,7 +173,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_Field), allocatable :: fcstField(:) type(ESMF_TypeKind_Flag) :: typekind character(len=80), allocatable :: fieldnamelist(:) - integer :: fieldDimCount, gridDimCount, tk + integer :: fieldDimCount, gridDimCount, tk, sloc integer, allocatable :: petMap(:) integer, allocatable :: gridToFieldMap(:) integer, allocatable :: ungriddedLBound(:) @@ -965,6 +965,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, tk = typekind ! convert TypeKind_Flag to integer call ESMF_InfoSet(info, key="typekind", value=tk, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + sloc = staggerloc ! convert StaggerLoc_Flag to integer + call ESMF_InfoSet(info, key="staggerloc", value=sloc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_InfoSet(info, key="gridToFieldMap", values=gridToFieldMap, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_InfoSet(info, key="ungriddedLBound", values=ungriddedLBound, rc=rc) @@ -1468,6 +1471,8 @@ subroutine wrt_initialize_p2(wrt_comp, imp_state_write, exp_state_write, clock, type(ESMF_FieldBundle) :: mirrorFB type(ESMF_Field), allocatable :: fieldList(:) type(ESMF_Grid) :: grid + integer :: sloc + type(ESMF_StaggerLoc) :: staggerloc type(ESMF_DistGrid) :: acceptorDG, newAcceptorDG ! ! @@ -1518,7 +1523,13 @@ subroutine wrt_initialize_p2(wrt_comp, imp_state_write, exp_state_write, clock, call ESMF_FieldBundleGet(mirrorFB, fieldList=fieldList, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return do j=1, fieldCount - call ESMF_FieldEmptySet(fieldList(j), grid=grid, rc=rc) + ! first access information stored on the field needed for completion + call ESMF_InfoGetFromHost(fieldList(j), info=info, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_InfoGet(info, key="staggerloc", value=sloc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + staggerloc = sloc ! convert integer into StaggerLoc_Flag + call ESMF_FieldEmptySet(fieldList(j), grid=grid, staggerloc=staggerloc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo ! clean-up @@ -1808,154 +1819,165 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) fieldbundle=mirror_bundle, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! Find the centerCoord of the moving domain + if (fcstItemNameList(i)(1:8) == "restart_") then + ! restart output forecast bundles, use Redist instead of Regrid - call ESMF_FieldBundleGet(mirror_bundle, fieldCount=fieldCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(fieldList(fieldCount)) - call ESMF_FieldBundleGet(mirror_bundle, fieldList=fieldList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(fieldList) + call ESMF_FieldBundleRedistStore(mirror_bundle, file_bundle, & + routehandle=rh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(grid, coordDim=1, array=coordArray(1), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(grid, coordDim=2, array=coordArray(2), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_ArrayGet(coordArray(1), distgrid=coordDG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_DistGridGet(coordDG, deCount=deCount, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, & - delayout=coordDL, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - allocate(petMap(deCount),minIndexPDe(2,deCount), maxIndexPDe(2,deCount)) - call ESMF_DELayoutGet(coordDL, petMap=petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_DistGridGet(coordDG, minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else ! not restart bundle - centerIndex(1) = (maxIndexPTile(1,1)-minIndexPTile(1,1)+1)/2 - centerIndex(2) = (maxIndexPTile(2,1)-minIndexPTile(2,1)+1)/2 - -! write(msgString,*) "Determined centerIndex: ", centerIndex -! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - do n=1, deCount - if (minIndexPDe(1,n)<=centerIndex(1) .and. centerIndex(1)<=maxIndexPDe(1,n) .and. & - minIndexPDe(2,n)<=centerIndex(2) .and. centerIndex(2)<=maxIndexPDe(2,n)) then - ! found the DE that holds the center coordinate - rootPet = petMap(n) - if (localPet == rootPet) then - ! center DE is on local PET -> fill centerCoord locally - call ESMF_ArrayGet(coordArray(1), farrayPtr=farrayPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - centerCoord(1) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) - call ESMF_ArrayGet(coordArray(2), farrayPtr=farrayPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - centerCoord(2) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) -! write(msgString,*) "Found centerCoord: ", centerCoord -! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! Find the centerCoord of the moving domain + call ESMF_FieldBundleGet(mirror_bundle, fieldCount=fieldCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(fieldList(fieldCount)) + call ESMF_FieldBundleGet(mirror_bundle, fieldList=fieldList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(fieldList(1), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + deallocate(fieldList) + + call ESMF_GridGetCoord(grid, coordDim=1, array=coordArray(1), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, array=coordArray(2), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(coordArray(1), distgrid=coordDG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, deCount=deCount, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, & + delayout=coordDL, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(petMap(deCount),minIndexPDe(2,deCount), maxIndexPDe(2,deCount)) + call ESMF_DELayoutGet(coordDL, petMap=petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_DistGridGet(coordDG, minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + centerIndex(1) = (maxIndexPTile(1,1)-minIndexPTile(1,1)+1)/2 + centerIndex(2) = (maxIndexPTile(2,1)-minIndexPTile(2,1)+1)/2 + + ! write(msgString,*) "Determined centerIndex: ", centerIndex + ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do n=1, deCount + if (minIndexPDe(1,n)<=centerIndex(1) .and. centerIndex(1)<=maxIndexPDe(1,n) .and. & + minIndexPDe(2,n)<=centerIndex(2) .and. centerIndex(2)<=maxIndexPDe(2,n)) then + ! found the DE that holds the center coordinate + rootPet = petMap(n) + if (localPet == rootPet) then + ! center DE is on local PET -> fill centerCoord locally + call ESMF_ArrayGet(coordArray(1), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(1) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) + call ESMF_ArrayGet(coordArray(2), farrayPtr=farrayPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + centerCoord(2) = farrayPtr(centerIndex(1)-minIndexPDe(1,n)+1,centerIndex(2)-minIndexPDe(2,n)+1) + ! write(msgString,*) "Found centerCoord: ", centerCoord + ! call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + exit endif - exit - endif - enddo + enddo - deallocate(petMap,minIndexPDe,maxIndexPDe) + deallocate(petMap,minIndexPDe,maxIndexPDe) - call ESMF_VMBroadcast(vm, centerCoord, count=2, rootPet=rootPet, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMBroadcast(vm, centerCoord, count=2, rootPet=rootPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - write(msgString,*) "All PETs know centerCoord in radians: ", centerCoord - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(msgString,*) "All PETs know centerCoord in radians: ", centerCoord + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_DEBUG, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! determine regridmethod - if (index(fcstItemNameList(i),"_bilinear") >0 ) then - traceString = "-bilinear" - regridmethod = ESMF_REGRIDMETHOD_BILINEAR - else if (index(fcstItemNameList(i),"_patch") >0) then - traceString = "-patch" - regridmethod = ESMF_REGRIDMETHOD_PATCH - else if (index(fcstItemNameList(i),"_nearest_stod") >0) then - traceString = "-nearest_stod" - regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD - else if (index(fcstItemNameList(i),"_nearest_dtos") >0) then - traceString = "-nearest_dtos" - regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS - else if (index(fcstItemNameList(i),"_conserve") >0) then - traceString = "-conserve" - regridmethod = ESMF_REGRIDMETHOD_CONSERVE - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="Unable to determine regrid method.", & - line=__LINE__, file=__FILE__, rcToReturn=rc) - return - endif - srcTermProcessing = 1 ! have this fixed for bit-for-bit reproducibility - ! RegridStore() + ! determine regridmethod + if (index(fcstItemNameList(i),"_bilinear") >0 ) then + traceString = "-bilinear" + regridmethod = ESMF_REGRIDMETHOD_BILINEAR + else if (index(fcstItemNameList(i),"_patch") >0) then + traceString = "-patch" + regridmethod = ESMF_REGRIDMETHOD_PATCH + else if (index(fcstItemNameList(i),"_nearest_stod") >0) then + traceString = "-nearest_stod" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_STOD + else if (index(fcstItemNameList(i),"_nearest_dtos") >0) then + traceString = "-nearest_dtos" + regridmethod = ESMF_REGRIDMETHOD_NEAREST_DTOS + else if (index(fcstItemNameList(i),"_conserve") >0) then + traceString = "-conserve" + regridmethod = ESMF_REGRIDMETHOD_CONSERVE + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="Unable to determine regrid method.", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + srcTermProcessing = 1 ! have this fixed for bit-for-bit reproducibility + ! RegridStore() - ! update output grid coordinates based of fcstgrid center lat/lon - call ESMF_FieldBundleGet(file_bundle, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(grid, coordDim=1, farrayPtr=lonPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(grid, coordDim=2, farrayPtr=latPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_AttributeGet(mirror_bundle, convention="NetCDF", purpose="FV3", & - name="grid_id", value=grid_id, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! update output grid coordinates based of fcstgrid center lat/lon + call ESMF_FieldBundleGet(file_bundle, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_AttributeGet(mirror_bundle, convention="NetCDF", purpose="FV3", & + name="grid_id", value=grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & - trim(output_grid(grid_id)) == 'rotated_latlon_moving') then - n = grid_id - cen_lon(n) = centerCoord(1)*rtod - cen_lat(n) = centerCoord(2)*rtod - if (cen_lon(n) > 180.0) cen_lon(n) = cen_lon(n) - 360.0 - cen_lon(n) = NINT(cen_lon(n)*1000.0)/1000.0 - cen_lat(n) = NINT(cen_lat(n)*1000.0)/1000.0 - endif + if (trim(output_grid(grid_id)) == 'regional_latlon_moving' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + n = grid_id + cen_lon(n) = centerCoord(1)*rtod + cen_lat(n) = centerCoord(2)*rtod + if (cen_lon(n) > 180.0) cen_lon(n) = cen_lon(n) - 360.0 + cen_lon(n) = NINT(cen_lon(n)*1000.0)/1000.0 + cen_lat(n) = NINT(cen_lat(n)*1000.0)/1000.0 + endif - if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then - lon1(n) = cen_lon(n) - 0.5 * (imo(n)-1) * dlon(n) - lat1(n) = cen_lat(n) - 0.5 * (jmo(n)-1) * dlat(n) - lon2(n) = cen_lon(n) + 0.5 * (imo(n)-1) * dlon(n) - lat2(n) = cen_lat(n) + 0.5 * (jmo(n)-1) * dlat(n) - do jj=lbound(lonPtr,2),ubound(lonPtr,2) - do ii=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(ii,jj) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) - latPtr(ii,jj) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) - wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) - wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) - enddo - enddo - else if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then - lon1(n) = - 0.5 * (imo(n)-1) * dlon(n) - lat1(n) = - 0.5 * (jmo(n)-1) * dlat(n) - lon2(n) = 0.5 * (imo(n)-1) * dlon(n) - lat2(n) = 0.5 * (jmo(n)-1) * dlat(n) - do jj=lbound(lonPtr,2),ubound(lonPtr,2) - do ii=lbound(lonPtr,1),ubound(lonPtr,1) - rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) - rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) - call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) - if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 - lonPtr(ii,jj) = geo_lon - latPtr(ii,jj) = geo_lat - wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) - wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) - enddo - enddo - endif + if (trim(output_grid(grid_id)) == 'regional_latlon_moving') then + lon1(n) = cen_lon(n) - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = cen_lat(n) - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = cen_lon(n) + 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = cen_lat(n) + 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(ii,jj) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + latPtr(ii,jj) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) + wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) + enddo + enddo + else if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then + lon1(n) = - 0.5 * (imo(n)-1) * dlon(n) + lat1(n) = - 0.5 * (jmo(n)-1) * dlat(n) + lon2(n) = 0.5 * (imo(n)-1) * dlon(n) + lat2(n) = 0.5 * (jmo(n)-1) * dlat(n) + do jj=lbound(lonPtr,2),ubound(lonPtr,2) + do ii=lbound(lonPtr,1),ubound(lonPtr,1) + rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) + rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + lonPtr(ii,jj) = geo_lon + latPtr(ii,jj) = geo_lat + wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) + wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) + enddo + enddo + endif + + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + call ESMF_FieldBundleRegridStore(mirror_bundle, file_bundle, & + regridMethod=regridmethod, routehandle=rh, & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=srcTermProcessing, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) + + endif ! fieldbundle restart vs. not restart - call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) - call ESMF_FieldBundleRegridStore(mirror_bundle, file_bundle, & - regridMethod=regridmethod, routehandle=rh, & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=srcTermProcessing, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()"//trim(traceString), rc=rc) ! Regrid() call ESMF_TraceRegionEnter("ESMF_FieldBundleRegrid()"//trim(traceString), rc=rc) call ESMF_FieldBundleRegrid(mirror_bundle, file_bundle, & From c124aaf43183828f899efd3fa5a1211ee19a497a Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 3 May 2023 15:29:31 +0000 Subject: [PATCH 6/8] Update atmos_cubed_sphere --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 1fc0452a9..1c3d6f486 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 1fc0452a911db7bc3366ff8b2f519e708c1be816 +Subproject commit 1c3d6f486a0f782239cc79d75f4eeb1cea96ef49 From 0379fd48f24dd67cab6f8b88b2b77fabfa7afc71 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Wed, 17 May 2023 11:52:47 +0000 Subject: [PATCH 7/8] Remove debug prints --- io/module_wrt_grid_comp.F90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 351f99047..94e568073 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -1004,24 +1004,9 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, enddo ! !loop over all items in the imp_state_write and count output FieldBundles - - ! if (lprnt) then - ! write(*,*)'wrt_initialize_p1: FBCount ', FBCount - ! do n=1, FBCount - ! write(*,*)'wrt_initialize_p1: ', n, trim(fcstItemNameList(n)) - ! enddo - ! endif - call get_outfile(FBCount, outfilename, FBlist_outfilename, noutfile) wrt_int_state%FBCount = noutfile - ! if (lprnt) then - ! write(*,*)'wrt_initialize_p1: wrt_int_state%FBCount ', wrt_int_state%FBCount - ! do i=1, wrt_int_state%FBCount - ! write(*,*)'wrt_initialize_p1: ', i, trim(FBlist_outfilename(i)) - ! enddo - ! endif - ! !create output field bundles allocate(wrt_int_state%wrtFB(wrt_int_state%FBCount)) From 16adf3f9daa7216e29c23a5f0486754b8706c2e6 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Fri, 19 May 2023 18:44:48 +0000 Subject: [PATCH 8/8] Revert .gitmodules and update atmos_cubed_sphere --- .gitmodules | 6 ++---- atmos_cubed_sphere | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index f87d49db1..22c723ac1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,9 +1,7 @@ [submodule "atmos_cubed_sphere"] path = atmos_cubed_sphere - #url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere - #branch = dev/emc - url = https://github.com/DusanJovic-NOAA/GFDL_atmos_cubed_sphere - branch = multiple_domains_quilting_restart + url = https://github.com/NOAA-GFDL/GFDL_atmos_cubed_sphere + branch = dev/emc [submodule "ccpp/framework"] path = ccpp/framework url = https://github.com/NCAR/ccpp-framework diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 1c3d6f486..4285e3f3a 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 1c3d6f486a0f782239cc79d75f4eeb1cea96ef49 +Subproject commit 4285e3f3a0bf6c054f8a08fc03469dee6b65e428