From 86ed4da2121911f102bf0075fa8010a88327e1f4 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Fri, 2 Aug 2024 10:55:37 -0400 Subject: [PATCH 01/12] increase number of exchanged fileds --- exchange/xgrid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/exchange/xgrid.F90 b/exchange/xgrid.F90 index 88cfdbbba..19e26b6d5 100644 --- a/exchange/xgrid.F90 +++ b/exchange/xgrid.F90 @@ -147,7 +147,7 @@ module xgrid_mod integer, parameter :: SECOND_ORDER = 2 integer, parameter :: VERSION1 = 1 !< grid spec file integer, parameter :: VERSION2 = 2 !< mosaic grid file -integer, parameter :: MAX_FIELDS = 80 +integer, parameter :: MAX_FIELDS = 100 logical :: make_exchange_reproduce = .false. !< Set to .true. to make xgrid_mod reproduce answers on different !! numbers of PEs. This option has a considerable performance impact. From 2021155b0245bde9766d69f6985877345cad20e2 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Fri, 2 Aug 2024 15:16:27 -0400 Subject: [PATCH 02/12] formatting --- coupler/generic_exchange.F90 | 186 +++++++++++++++++++++++++++++++++++ 1 file changed, 186 insertions(+) create mode 100644 coupler/generic_exchange.F90 diff --git a/coupler/generic_exchange.F90 b/coupler/generic_exchange.F90 new file mode 100644 index 000000000..95a259f30 --- /dev/null +++ b/coupler/generic_exchange.F90 @@ -0,0 +1,186 @@ + +!>simple routine to pass non-tracer fields across components (regridding) + +module gex_mod + + +use fms_mod, only: lowercase, error_mesg, FATAL, NOTE +use tracer_manager_mod, only: NO_TRACER +use field_manager_mod, only: MODEL_LAND, MODEL_ATMOS, NUM_MODELS +use field_manager_mod, only: fm_list_iter_type, fm_dump_list, fm_field_name_len, & + fm_type_name_len, fm_get_length,fm_loop_over_list, fm_init_loop, & + fm_string_len, fm_get_current_list, fm_path_name_len, fm_change_list +use fm_util_mod, only: fm_util_get_real, fm_util_get_logical, fm_util_get_string +use mpp_mod, only: mpp_root_pe, mpp_pe + +implicit none ; private + +public :: gex_init, gex_get_index,gex_get_n, gex_get_p, gex_name, gex_units + +character(3) :: module_name = 'gex' +logical :: initialized = .FALSE. + +integer, parameter :: gex_name = 1 +integer, parameter :: gex_units = 2 + +type gex_type + character(fm_field_name_len):: name + character(fm_string_len) :: units +end type gex_type +type gex_type_r + type(gex_type), allocatable:: field(:) +end type gex_type_r + +integer, allocatable :: n_gex(:,:) +type(gex_type_r), allocatable :: gex_fields(:,:) + +contains + +!####################################################################### +!> Generic exchange between model components (initiatization) +!####################################################################### + +subroutine gex_init() + + if (initialized) return + + allocate(n_gex(NUM_MODELS,NUM_MODELS)) + allocate(gex_fields(NUM_MODELS,NUM_MODELS)) + + n_gex(:,:) = 0 + + if (mpp_pe()==mpp_root_pe()) write(*,*) '' + if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' + if (mpp_pe()==mpp_root_pe()) write(*,*) '# generic exchanged fields [gex] #' + if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' + if (mpp_pe()==mpp_root_pe()) write(*,*) '' + + call gex_read_field_table('/coupler_mod/atm_lnd_ex',MODEL_ATMOS,MODEL_LAND) + call gex_read_field_table('/coupler_mod/lnd_atm_ex',MODEL_LAND,MODEL_ATMOS) + if (mpp_pe()==mpp_root_pe()) write(*,*) '' + if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' + if (mpp_pe()==mpp_root_pe()) write(*,*) '' + + initialized = .TRUE. + +end subroutine gex_init + +!####################################################################### +!> Generic exchange between model components - process fields for a given exchange +!####################################################################### + +subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) + + integer, intent(in) :: MODEL_SRC,MODEL_REC + character(len=*), intent(in) :: listroot + + type(fm_list_iter_type) :: iter ! iterator over the list of species + + character(fm_field_name_len) :: name = '' ! name of the species + character(fm_type_name_len) :: ftype ! type of the field table entry + character(fm_path_name_len) :: current_list ! storage for current location in the fiels manager tree + character(fm_path_name_len) :: listname ! name of the field manager list + + integer :: n + + if(fm_dump_list(listroot, recursive=.TRUE.)) then + n_gex(MODEL_SRC,MODEL_REC) = fm_get_length(listroot) + allocate(gex_fields(MODEL_SRC,MODEL_REC)%field(n_gex(MODEL_SRC,MODEL_REC))) + + call fm_init_loop(listroot,iter) + do while (fm_loop_over_list(iter, name, ftype, n)) + gex_fields(MODEL_SRC,MODEL_REC)%field(n)%name = trim(name) + if (mpp_pe()==mpp_root_pe()) write(*,*) listroot,n,trim(name) + + ! save current position in the field manager tree to restore it on exit + current_list = fm_get_current_list() + if (current_list .eq. ' ') call error_mesg(module_name,'Could not get the current list',FATAL) + + listname = trim(listroot)//'/'//trim(name) + + if (.not.fm_change_list(listname)) then + call error_mesg(module_name,'Cannot change fm list to "'//trim(listname)//'"', FATAL) + endif + + gex_fields(MODEL_SRC,MODEL_REC)%field(n)%units = & + fm_util_get_string('units', & + caller = 'field_manager', default_value = '', scalar = .true.) + + if (.not.fm_change_list(current_list)) then + call error_mesg(module_name,'Cannot change fm list back to "'//trim(current_list)//'"', FATAL) + endif + end do + else + call error_mesg('flux_exchange','Cannot dump field list "/coupler_mod/lnd_atm_ex". No additional field will be exchanged from land to atmosphere',NOTE) + end if + +end subroutine + + +!####################################################################### +!> Generic exchange between model components - return number of fields exchanged +!####################################################################### + +function gex_get_n(MODEL_SRC,MODEL_REC) + + integer, intent(in) :: MODEL_SRC, MODEL_REC + integer gex_get_n + + gex_get_n = n_gex(MODEL_SRC,MODEL_REC) + + return + +end function + +!####################################################################### +!> Generic exchange between model components - return name of field +!####################################################################### + +function gex_get_p(MODEL_SRC,MODEL_REC,index,property) + + integer, intent(in) :: MODEL_SRC, MODEL_REC,index + integer :: property + character(len=64) :: gex_get_p + + if (index.le.n_gex(MODEL_SRC,MODEL_REC)) then + if (property .eq. gex_name) then + gex_get_p = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name) + elseif (property .eq. gex_units) then + gex_get_p = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%units) + else + call error_mesg('flux_exchange|gex','property does not exist: '//gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name,FATAL) + end if + else + call error_mesg('flux_exchange|gex','requested tracer does not exist',FATAL) + end if + + return + +end function + +!####################################################################### +!> Generic exchange between model components - return index of exchange field +!####################################################################### + +function gex_get_index(MODEL_SRC,MODEL_REC,name) + + character(len=*), intent(in) :: name !< name of the tracer + integer, intent(in) :: MODEL_SRC, MODEL_REC + + integer :: i + integer :: gex_get_index + + gex_get_index = NO_TRACER + + do i = 1, n_gex(MODEL_SRC,MODEL_REC) + if (lowercase(trim(name)) == trim(gex_fields(MODEL_SRC,MODEL_REC)%field(i)%name))then + gex_get_index = i + exit + endif + enddo + + return + +end function gex_get_index + +end module gex_mod \ No newline at end of file From bc241ea106ff1ae8d7e0476f11b66af74aa83f90 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Thu, 22 Aug 2024 09:55:54 -0400 Subject: [PATCH 03/12] changes for gex --- coupler/generic_exchange.F90 | 71 +++++++++++++++++++++++------------- 1 file changed, 45 insertions(+), 26 deletions(-) diff --git a/coupler/generic_exchange.F90 b/coupler/generic_exchange.F90 index 95a259f30..473a148db 100644 --- a/coupler/generic_exchange.F90 +++ b/coupler/generic_exchange.F90 @@ -1,5 +1,4 @@ - -!>simple routine to pass non-tracer fields across components (regridding) +!>simple routine to pass non-tracer fields across components (regrid) module gex_mod @@ -15,7 +14,7 @@ module gex_mod implicit none ; private -public :: gex_init, gex_get_index,gex_get_n, gex_get_p, gex_name, gex_units +public :: gex_init, gex_get_index,gex_get_n_ex, gex_get_property, gex_name, gex_units character(3) :: module_name = 'gex' logical :: initialized = .FALSE. @@ -26,6 +25,7 @@ module gex_mod type gex_type character(fm_field_name_len):: name character(fm_string_len) :: units + logical :: set end type gex_type type gex_type_r type(gex_type), allocatable:: field(:) @@ -49,18 +49,24 @@ subroutine gex_init() n_gex(:,:) = 0 - if (mpp_pe()==mpp_root_pe()) write(*,*) '' - if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' - if (mpp_pe()==mpp_root_pe()) write(*,*) '# generic exchanged fields [gex] #' - if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' - if (mpp_pe()==mpp_root_pe()) write(*,*) '' + if (mpp_pe()==mpp_root_pe()) then + write(*,*) '' + write(*,*) '####################################' + write(*,*) '# generic exchanged fields [gex] #' + write(*,*) '####################################' + write(*,*) '' + end if + - call gex_read_field_table('/coupler_mod/atm_lnd_ex',MODEL_ATMOS,MODEL_LAND) - call gex_read_field_table('/coupler_mod/lnd_atm_ex',MODEL_LAND,MODEL_ATMOS) - if (mpp_pe()==mpp_root_pe()) write(*,*) '' - if (mpp_pe()==mpp_root_pe()) write(*,*) '####################################' - if (mpp_pe()==mpp_root_pe()) write(*,*) '' + call gex_read_field_table('/coupler_mod/atm_to_lnd_ex',MODEL_ATMOS,MODEL_LAND) + call gex_read_field_table('/coupler_mod/lnd_to_atm_ex',MODEL_LAND,MODEL_ATMOS) + if (mpp_pe()==mpp_root_pe()) then + write(*,*) '' + write(*,*) '####################################' + write(*,*) '' + end if + initialized = .TRUE. end subroutine gex_init @@ -84,12 +90,13 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) integer :: n if(fm_dump_list(listroot, recursive=.TRUE.)) then - n_gex(MODEL_SRC,MODEL_REC) = fm_get_length(listroot) - allocate(gex_fields(MODEL_SRC,MODEL_REC)%field(n_gex(MODEL_SRC,MODEL_REC))) + n_gex(MODEL_SRC,MODEL_REC) = fm_get_length(listroot) + allocate(gex_fields(MODEL_SRC,MODEL_REC)%field(n_gex(MODEL_SRC,MODEL_REC))) call fm_init_loop(listroot,iter) do while (fm_loop_over_list(iter, name, ftype, n)) gex_fields(MODEL_SRC,MODEL_REC)%field(n)%name = trim(name) + gex_fields(MODEL_SRC,MODEL_REC)%field(n)%set = .FALSE. if (mpp_pe()==mpp_root_pe()) write(*,*) listroot,n,trim(name) ! save current position in the field manager tree to restore it on exit @@ -111,7 +118,7 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) endif end do else - call error_mesg('flux_exchange','Cannot dump field list "/coupler_mod/lnd_atm_ex". No additional field will be exchanged from land to atmosphere',NOTE) + call error_mesg('flux_exchange','Cannot dump field list '//listroot//'. No additional field will be exchanged from land to atmosphere',NOTE) end if end subroutine @@ -121,12 +128,12 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) !> Generic exchange between model components - return number of fields exchanged !####################################################################### -function gex_get_n(MODEL_SRC,MODEL_REC) +function gex_get_n_ex(MODEL_SRC,MODEL_REC) integer, intent(in) :: MODEL_SRC, MODEL_REC - integer gex_get_n + integer gex_get_n_ex - gex_get_n = n_gex(MODEL_SRC,MODEL_REC) + gex_get_n_ex = n_gex(MODEL_SRC,MODEL_REC) return @@ -136,17 +143,17 @@ function gex_get_n(MODEL_SRC,MODEL_REC) !> Generic exchange between model components - return name of field !####################################################################### -function gex_get_p(MODEL_SRC,MODEL_REC,index,property) +function gex_get_property(MODEL_SRC,MODEL_REC,index,property) integer, intent(in) :: MODEL_SRC, MODEL_REC,index integer :: property - character(len=64) :: gex_get_p + character(len=64) :: gex_get_property if (index.le.n_gex(MODEL_SRC,MODEL_REC)) then if (property .eq. gex_name) then - gex_get_p = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name) + gex_get_property = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name) elseif (property .eq. gex_units) then - gex_get_p = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%units) + gex_get_property = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%units) else call error_mesg('flux_exchange|gex','property does not exist: '//gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name,FATAL) end if @@ -162,10 +169,11 @@ function gex_get_p(MODEL_SRC,MODEL_REC,index,property) !> Generic exchange between model components - return index of exchange field !####################################################################### -function gex_get_index(MODEL_SRC,MODEL_REC,name) +function gex_get_index(MODEL_SRC,MODEL_REC,name,record) character(len=*), intent(in) :: name !< name of the tracer integer, intent(in) :: MODEL_SRC, MODEL_REC + logical, intent(in), optional :: record !record that this exchanged has been found and will be set integer :: i integer :: gex_get_index @@ -175,12 +183,23 @@ function gex_get_index(MODEL_SRC,MODEL_REC,name) do i = 1, n_gex(MODEL_SRC,MODEL_REC) if (lowercase(trim(name)) == trim(gex_fields(MODEL_SRC,MODEL_REC)%field(i)%name))then gex_get_index = i + + if (present(record)) then + if (record) then + gex_fields(MODEL_SRC,MODEL_REC)%field(i)%set = .TRUE. + end if + else + if (.not. gex_fields(MODEL_SRC,MODEL_REC)%field(i)%set) then + call error_mesg('flux_exchange|gex','requested flux was never set',FATAL) + end if + end if + exit endif enddo - + return end function gex_get_index -end module gex_mod \ No newline at end of file +end module gex_mod From 15798341fb5bfbce9d02077153bf97ef27def388 Mon Sep 17 00:00:00 2001 From: Sergey Malyshev Date: Tue, 3 Sep 2024 09:23:54 -0400 Subject: [PATCH 04/12] Add ability to read units for tracers in GEX sections of field table Examples: "atm_to_lnd_ex","coupler_mod","wetbc" units = kg/(m2 s) / "lnd_to_atm_ex","coupler_mod","test1" units = kg/m2/year / --- coupler/generic_exchange.F90 | 132 +++++++++++++++++++---------------- 1 file changed, 72 insertions(+), 60 deletions(-) diff --git a/coupler/generic_exchange.F90 b/coupler/generic_exchange.F90 index 473a148db..fd9836ad8 100644 --- a/coupler/generic_exchange.F90 +++ b/coupler/generic_exchange.F90 @@ -23,13 +23,13 @@ module gex_mod integer, parameter :: gex_units = 2 type gex_type - character(fm_field_name_len):: name - character(fm_string_len) :: units - logical :: set + character(fm_field_name_len):: name = '' + character(fm_string_len) :: units = '' + logical :: set = .FALSE. end type gex_type type gex_type_r type(gex_type), allocatable:: field(:) -end type gex_type_r +end type gex_type_r integer, allocatable :: n_gex(:,:) type(gex_type_r), allocatable :: gex_fields(:,:) @@ -56,79 +56,91 @@ subroutine gex_init() write(*,*) '####################################' write(*,*) '' end if - + call gex_read_field_table('/coupler_mod/atm_to_lnd_ex',MODEL_ATMOS,MODEL_LAND) call gex_read_field_table('/coupler_mod/lnd_to_atm_ex',MODEL_LAND,MODEL_ATMOS) if (mpp_pe()==mpp_root_pe()) then - write(*,*) '' + write(*,*) '' write(*,*) '####################################' - write(*,*) '' + write(*,*) '' end if - + initialized = .TRUE. end subroutine gex_init !####################################################################### !> Generic exchange between model components - process fields for a given exchange -!####################################################################### +!####################################################################### subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) - integer, intent(in) :: MODEL_SRC,MODEL_REC - character(len=*), intent(in) :: listroot - - type(fm_list_iter_type) :: iter ! iterator over the list of species - - character(fm_field_name_len) :: name = '' ! name of the species - character(fm_type_name_len) :: ftype ! type of the field table entry - character(fm_path_name_len) :: current_list ! storage for current location in the fiels manager tree - character(fm_path_name_len) :: listname ! name of the field manager list - - integer :: n - - if(fm_dump_list(listroot, recursive=.TRUE.)) then - n_gex(MODEL_SRC,MODEL_REC) = fm_get_length(listroot) - allocate(gex_fields(MODEL_SRC,MODEL_REC)%field(n_gex(MODEL_SRC,MODEL_REC))) - - call fm_init_loop(listroot,iter) - do while (fm_loop_over_list(iter, name, ftype, n)) - gex_fields(MODEL_SRC,MODEL_REC)%field(n)%name = trim(name) - gex_fields(MODEL_SRC,MODEL_REC)%field(n)%set = .FALSE. - if (mpp_pe()==mpp_root_pe()) write(*,*) listroot,n,trim(name) - - ! save current position in the field manager tree to restore it on exit - current_list = fm_get_current_list() - if (current_list .eq. ' ') call error_mesg(module_name,'Could not get the current list',FATAL) - + character(len=*), intent(in) :: listroot ! name of the field manager list + integer, intent(in) :: MODEL_SRC ! index of the model where the tracer comes FROM + integer, intent(in) :: MODEL_REC ! index of the model where the tracer goes TO + + type(fm_list_iter_type) :: iter ! iterator over the list of tracers + character(fm_field_name_len) :: name = '' ! name of the tracer + character(fm_type_name_len) :: ftype ! type of the field table entry (not used) +! character(fm_path_name_len) :: current_list ! storage for current location in the fiels manager tree + character(fm_path_name_len) :: listname ! name of the field manager list for each tracer + + integer :: n + + if(.not.fm_dump_list(listroot, recursive=.TRUE.)) then + call error_mesg('gex_read_field_table','Cannot dump field list "'//listroot//'". No additional field will be exchanged from land to atmosphere',NOTE) + return + endif + + n_gex(MODEL_SRC,MODEL_REC) = fm_get_length(listroot) + allocate(gex_fields(MODEL_SRC,MODEL_REC)%field(n_gex(MODEL_SRC,MODEL_REC))) + + call fm_init_loop(listroot,iter) + do while (fm_loop_over_list(iter, name, ftype, n)) + associate(fld=>gex_fields(MODEL_SRC,MODEL_REC)%field(n)) ! define a shorthand, to avoid very long expressions + fld%name = trim(name) + fld%set = .FALSE. + + ! read parameters of the tracer + + ! I am not sure saving/restoring "current_list" is necessary: it seems to work + ! without it. I just left it here commented out + + ! save current filed manager list +! current_list = fm_get_current_list() +! if (current_list .eq. ' ') & +! call error_mesg(module_name,'Could not get the current list',FATAL) + + ! switch to the list of tracer parameters listname = trim(listroot)//'/'//trim(name) - if (.not.fm_change_list(listname)) then call error_mesg(module_name,'Cannot change fm list to "'//trim(listname)//'"', FATAL) endif - - gex_fields(MODEL_SRC,MODEL_REC)%field(n)%units = & - fm_util_get_string('units', & - caller = 'field_manager', default_value = '', scalar = .true.) - - if (.not.fm_change_list(current_list)) then - call error_mesg(module_name,'Cannot change fm list back to "'//trim(current_list)//'"', FATAL) - endif - end do - else - call error_mesg('flux_exchange','Cannot dump field list '//listroot//'. No additional field will be exchanged from land to atmosphere',NOTE) - end if - -end subroutine + ! read parameters + fld%units = fm_util_get_string('units', caller = module_name, default_value = '', scalar = .true.) + ! other parameters can be read here, for example: + ! fld%molar_mass = get_spdata_real('molar_mass', caller = module_name, default_value=12.0, scalar=.true.) + + ! restore to the original list +! if (.not.fm_change_list(current_list)) then +! call error_mesg(module_name,'Cannot change fm list back to "'//trim(current_list)//'"', FATAL) +! endif + + if (mpp_pe()==mpp_root_pe()) write(*,*) listroot,n,& + ' name="'//trim(fld%name)//'"', & + ' units="'//trim(fld%units)//'"' + end associate + end do +end subroutine !####################################################################### !> Generic exchange between model components - return number of fields exchanged -!####################################################################### +!####################################################################### -function gex_get_n_ex(MODEL_SRC,MODEL_REC) +function gex_get_n_ex(MODEL_SRC,MODEL_REC) integer, intent(in) :: MODEL_SRC, MODEL_REC integer gex_get_n_ex @@ -141,7 +153,7 @@ function gex_get_n_ex(MODEL_SRC,MODEL_REC) !####################################################################### !> Generic exchange between model components - return name of field -!####################################################################### +!####################################################################### function gex_get_property(MODEL_SRC,MODEL_REC,index,property) @@ -163,15 +175,15 @@ function gex_get_property(MODEL_SRC,MODEL_REC,index,property) return -end function +end function !####################################################################### !> Generic exchange between model components - return index of exchange field -!####################################################################### +!####################################################################### function gex_get_index(MODEL_SRC,MODEL_REC,name,record) - character(len=*), intent(in) :: name !< name of the tracer + character(len=*), intent(in) :: name !< name of the tracer integer, intent(in) :: MODEL_SRC, MODEL_REC logical, intent(in), optional :: record !record that this exchanged has been found and will be set @@ -190,15 +202,15 @@ function gex_get_index(MODEL_SRC,MODEL_REC,name,record) end if else if (.not. gex_fields(MODEL_SRC,MODEL_REC)%field(i)%set) then - call error_mesg('flux_exchange|gex','requested flux was never set',FATAL) + call error_mesg('flux_exchange|gex','requested flux was never set',FATAL) end if end if - + exit endif enddo - - return + + return end function gex_get_index From 7d9789329abea77d9691eb53052972000a622af4 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Tue, 1 Oct 2024 12:30:25 -0400 Subject: [PATCH 05/12] change spacing --- coupler/generic_exchange.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/coupler/generic_exchange.F90 b/coupler/generic_exchange.F90 index fd9836ad8..89432413a 100644 --- a/coupler/generic_exchange.F90 +++ b/coupler/generic_exchange.F90 @@ -31,7 +31,7 @@ module gex_mod type(gex_type), allocatable:: field(:) end type gex_type_r -integer, allocatable :: n_gex(:,:) +integer, allocatable :: n_gex(:,:) type(gex_type_r), allocatable :: gex_fields(:,:) contains From b7a26bbe7aaffb86ad81578b4dcd476721626d0f Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Mon, 27 Jan 2025 17:07:40 -0500 Subject: [PATCH 06/12] Renamed generic_exchange to gex to match FMS style. Update Makefile.am and CMAkeLists.txt --- CMakeLists.txt | 1 + coupler/Makefile.am | 4 +++- coupler/{generic_exchange.F90 => gex.F90} | 7 +++++-- 3 files changed, 9 insertions(+), 3 deletions(-) rename coupler/{generic_exchange.F90 => gex.F90} (96%) diff --git a/CMakeLists.txt b/CMakeLists.txt index 17db1a462..5b733b15b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -112,6 +112,7 @@ list(APPEND fms_fortran_src_files constants4/constantsr4.F90 constants4/fmsconstantsr4.F90 coupler/atmos_ocean_fluxes.F90 + coupler/gex.F90 coupler/coupler_types.F90 coupler/ensemble_manager.F90 data_override/get_grid_version.F90 diff --git a/coupler/Makefile.am b/coupler/Makefile.am index d6c8f0dec..fc88610a5 100644 --- a/coupler/Makefile.am +++ b/coupler/Makefile.am @@ -34,6 +34,7 @@ libcoupler_la_SOURCES = \ coupler_types.F90 \ ensemble_manager.F90 \ atmos_ocean_fluxes.F90 \ + gex.F90 \ include/coupler_types.inc \ include/coupler_types_r4.fh \ include/coupler_types_r8.fh @@ -45,7 +46,8 @@ atmos_ocean_fluxes_mod.$(FC_MODEXT): coupler_types_mod.$(FC_MODEXT) MODFILES = \ coupler_types_mod.$(FC_MODEXT) \ ensemble_manager_mod.$(FC_MODEXT) \ - atmos_ocean_fluxes_mod.$(FC_MODEXT) + atmos_ocean_fluxes_mod.$(FC_MODEXT) \ + gex_mod.$(FC_MODEXT) nodist_include_HEADERS = $(MODFILES) BUILT_SOURCES = $(MODFILES) diff --git a/coupler/generic_exchange.F90 b/coupler/gex.F90 similarity index 96% rename from coupler/generic_exchange.F90 rename to coupler/gex.F90 index 89432413a..8ad58540d 100644 --- a/coupler/generic_exchange.F90 +++ b/coupler/gex.F90 @@ -90,7 +90,9 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) integer :: n if(.not.fm_dump_list(listroot, recursive=.TRUE.)) then - call error_mesg('gex_read_field_table','Cannot dump field list "'//listroot//'". No additional field will be exchanged from land to atmosphere',NOTE) + call error_mesg('gex_read_field_table', & + 'Cannot dump field list "'//listroot//'". No additional field will be exchanged from land to atmosphere',& + NOTE) return endif @@ -167,7 +169,8 @@ function gex_get_property(MODEL_SRC,MODEL_REC,index,property) elseif (property .eq. gex_units) then gex_get_property = trim(gex_fields(MODEL_SRC,MODEL_REC)%field(index)%units) else - call error_mesg('flux_exchange|gex','property does not exist: '//gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name,FATAL) + call error_mesg('flux_exchange|gex','property does not exist: '// & + gex_fields(MODEL_SRC,MODEL_REC)%field(index)%name,FATAL) end if else call error_mesg('flux_exchange|gex','requested tracer does not exist',FATAL) From 30dbf61518b7e6826f41da10f4d29293c8680a77 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Mon, 27 Jan 2025 17:24:07 -0500 Subject: [PATCH 07/12] Remove whitespace --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5b733b15b..01f70c90b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -112,7 +112,7 @@ list(APPEND fms_fortran_src_files constants4/constantsr4.F90 constants4/fmsconstantsr4.F90 coupler/atmos_ocean_fluxes.F90 - coupler/gex.F90 + coupler/gex.F90 coupler/coupler_types.F90 coupler/ensemble_manager.F90 data_override/get_grid_version.F90 From 2bdd1cb40252bca4d18fe1df0cb99224c1b778c4 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Mon, 3 Feb 2025 10:55:59 -0500 Subject: [PATCH 08/12] move Needs to have tracer_manager before coupler in the SUBDIRS list so the module dependency is satisfied per Ryan's recommendation --- Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index c97869a75..d46b3b655 100644 --- a/Makefile.am +++ b/Makefile.am @@ -59,6 +59,7 @@ SUBDIRS = \ data_override \ astronomy \ field_manager \ + tracer_manager \ coupler \ diag_integral \ monin_obukhov \ @@ -66,7 +67,6 @@ SUBDIRS = \ amip_interp \ exchange \ topography \ - tracer_manager \ sat_vapor_pres \ random_numbers \ . \ From 745f2c797feb6816dadd6a0d2d4f6fff38b068c0 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Mon, 3 Feb 2025 12:59:43 -0500 Subject: [PATCH 09/12] Formatting/Doc --- coupler/gex.F90 | 75 ++++++++++++++++++++++++++++++++----------------- libFMS.F90 | 8 ++++++ 2 files changed, 58 insertions(+), 25 deletions(-) diff --git a/coupler/gex.F90 b/coupler/gex.F90 index 8ad58540d..0b3c18b66 100644 --- a/coupler/gex.F90 +++ b/coupler/gex.F90 @@ -1,4 +1,33 @@ -!>simple routine to pass non-tracer fields across components (regrid) +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +!> @defgroup gex_mod gex_mod +!> @ingroup gex +!> @brief Simple generic exchange (gex) interface to pass (non-tracer) fields across components +!> @author Fabien Paulot +!! + +!> @file +!> @brief File for @ref gex_mod + +!> @addtogroup gex_mod +!> @{ module gex_mod @@ -16,17 +45,22 @@ module gex_mod public :: gex_init, gex_get_index,gex_get_n_ex, gex_get_property, gex_name, gex_units -character(3) :: module_name = 'gex' -logical :: initialized = .FALSE. +character(3) :: module_name = 'gex' !< module name +logical :: initialized = .FALSE. !< is module initialized -integer, parameter :: gex_name = 1 -integer, parameter :: gex_units = 2 +integer, parameter :: gex_name = 1 !< internal index for gex_name +integer, parameter :: gex_units = 2 !< internal index for gex unit + +!> @brief This type represents the entries for a specific exchanged field +!> @ingroup gex_mod type gex_type character(fm_field_name_len):: name = '' character(fm_string_len) :: units = '' logical :: set = .FALSE. end type gex_type +!> @brief This type stores information about all the exchanged fields +!> @ingroup gex_mod type gex_type_r type(gex_type), allocatable:: field(:) end type gex_type_r @@ -36,10 +70,9 @@ module gex_mod contains -!####################################################################### -!> Generic exchange between model components (initiatization) -!####################################################################### - +!> @addtogroup gex_mod + !> @{ +!> @brief Subroutine to initialize generic exchange between model components subroutine gex_init() if (initialized) return @@ -71,10 +104,7 @@ subroutine gex_init() end subroutine gex_init -!####################################################################### -!> Generic exchange between model components - process fields for a given exchange -!####################################################################### - +!> @brief Subroutine to fields for a given exchange subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) character(len=*), intent(in) :: listroot ! name of the field manager list @@ -138,10 +168,7 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) end subroutine -!####################################################################### -!> Generic exchange between model components - return number of fields exchanged -!####################################################################### - +!> @brief Function to return number of fields exchanged function gex_get_n_ex(MODEL_SRC,MODEL_REC) integer, intent(in) :: MODEL_SRC, MODEL_REC @@ -153,10 +180,7 @@ function gex_get_n_ex(MODEL_SRC,MODEL_REC) end function -!####################################################################### -!> Generic exchange between model components - return name of field -!####################################################################### - +!> @brief Function to return name of field function gex_get_property(MODEL_SRC,MODEL_REC,index,property) integer, intent(in) :: MODEL_SRC, MODEL_REC,index @@ -180,10 +204,7 @@ function gex_get_property(MODEL_SRC,MODEL_REC,index,property) end function -!####################################################################### -!> Generic exchange between model components - return index of exchange field -!####################################################################### - +!> @brief Function to return index of exchanged field function gex_get_index(MODEL_SRC,MODEL_REC,name,record) character(len=*), intent(in) :: name !< name of the tracer @@ -218,3 +239,7 @@ function gex_get_index(MODEL_SRC,MODEL_REC,name,record) end function gex_get_index end module gex_mod + + +!> @} +! close documentation grouping diff --git a/libFMS.F90 b/libFMS.F90 index 09296b76a..86527ad4e 100644 --- a/libFMS.F90 +++ b/libFMS.F90 @@ -803,6 +803,14 @@ module fms fms_time_manager_date_to_string => date_to_string use get_cal_time_mod, only: fms_get_cal_time => get_cal_time + !> generic exchange + use gex_mod, only: fms_gex_init => gex_init, & + fms_gex_get_index => gex_get_index, & + fms_gex_get_n_ex => gex_get_n_ex, & + fms_gex_get_property => gex_get_property, & + fms_gex_name => gex_name, & + fms_gex_units => gex_units + !> topography use gaussian_topog_mod, only: fms_gaussian_topog_init => gaussian_topog_init, & fms_get_gaussian_topog => get_gaussian_topog From 5536f7e51eb037161d4b01d75c8301acc4d879e8 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Mon, 3 Feb 2025 13:02:34 -0500 Subject: [PATCH 10/12] White space --- libFMS.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libFMS.F90 b/libFMS.F90 index 86527ad4e..37c26eb73 100644 --- a/libFMS.F90 +++ b/libFMS.F90 @@ -805,12 +805,12 @@ module fms !> generic exchange use gex_mod, only: fms_gex_init => gex_init, & - fms_gex_get_index => gex_get_index, & + fms_gex_get_index => gex_get_index, & fms_gex_get_n_ex => gex_get_n_ex, & fms_gex_get_property => gex_get_property, & fms_gex_name => gex_name, & fms_gex_units => gex_units - + !> topography use gaussian_topog_mod, only: fms_gaussian_topog_init => gaussian_topog_init, & fms_get_gaussian_topog => get_gaussian_topog From 37c19a6eae3f0be99c6ecbe2263df17204b3c031 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Wed, 12 Feb 2025 10:51:43 -0500 Subject: [PATCH 11/12] add documentation for generic exchange --- coupler/gex.F90 | 163 ++++++++++++++++++++++++++++++------------------ 1 file changed, 101 insertions(+), 62 deletions(-) diff --git a/coupler/gex.F90 b/coupler/gex.F90 index 0b3c18b66..1ac89b79e 100644 --- a/coupler/gex.F90 +++ b/coupler/gex.F90 @@ -20,21 +20,89 @@ !> @defgroup gex_mod gex_mod !> @ingroup gex !> @brief Simple generic exchange (gex) interface to pass (non-tracer) fields across components -!> @author Fabien Paulot +!> @author Fabien Paulot (Fabien.Paulot@noaa.gov) +!! +!! +!! +!!# 1. Introduction +!! +!!**gex** provides a generic interface to pass diagnostic fields across components. +!!This interface is not meant to pass tracers across components. +!! +!!# 2. Setup +!! +!!## 2.1. Field table +!! +!!Each exchanged field needs to be specified in the `coupler_mod` field table as: +!! +!!> SENDING_COMPONENT_to_RECEIVING_COMPONENT_ex, "coupler_mod", GEX_NAME +!! +!!`SENDING_COMPONENT` and `RECEIVING_COMPONENT` can be `lnd`, `atm` and `ocn` +!!`GEX_NAME` is the name under which the exchanged field is stored within **gex** +!! +!!Additional information can be provided regarding the field units. +!! +!!*Example* +!! +!! "atm_to_lnd_ex","coupler_mod","dryoa" +!! unit=kg/m2/s, +!! / +!! +!! +!! +!!## 2.2 Sending routine +!! +!!Two things need to happen: +!! +!!- At initialization, obtain index of exchanged field via: +!! +!! GEX_INDEX = gex_get_index(SENDING_COMPONENT,RECEIVING_COMPONENT,GEX_NAME) +!! +!! Returns `NO_TRACER` if `gex_name` is not found +!! +!! *Example* +!! +!! gex_dryoa = gex_get_index(MODEL_ATMOS,MODEL_LAND,'dryoa') +!! +!! requests index for `dryoa` field (exchanged from atmos->land) in gex. +!! +!!- Populate exchanged field +!! +!! gex_array(:,:,GEX_INDEX) = SOME_VALUE +!! +!! `gex array` is an array that contains all exchanged fields in the sending component. +!! It needs to be made available in the routine where the field of interest is calculated. +!! +!! *Example* +!! +!! gex_atm2lnd(:,:,gex_dryoa) = pwt(:,:,kd)*dsinku_lnd(:,:,nomphilic) +!! +!! stores the total OA deposition +!! +!!## 2.3 Receiving routine +!! +!!Receiving is very similar to sending. +!! +!!- To get the index of requested field (at initialization) +!! +!! GEX_INDEX = gex_get_index(SENDING_COMPONENT,RECEIVING_COMPONENT,GEX_NAME) +!! +!!- To get value of exchanged field +!! +!! gex_array(:,:,GEX_INDEX) +!! +!! `gex array` is an array that contains all exchanged fields in the receiving component. +!! It needs to be made available in the routine where the field of interest is needed !! - !> @file -!> @brief File for @ref gex_mod - !> @addtogroup gex_mod -!> @{ +!> @brief File for @ref gex_mod module gex_mod - use fms_mod, only: lowercase, error_mesg, FATAL, NOTE use tracer_manager_mod, only: NO_TRACER -use field_manager_mod, only: MODEL_LAND, MODEL_ATMOS, NUM_MODELS +use field_manager_mod, only: MODEL_LAND, MODEL_ATMOS, MODEL_OCEAN, NUM_MODELS use field_manager_mod, only: fm_list_iter_type, fm_dump_list, fm_field_name_len, & fm_type_name_len, fm_get_length,fm_loop_over_list, fm_init_loop, & fm_string_len, fm_get_current_list, fm_path_name_len, fm_change_list @@ -51,14 +119,13 @@ module gex_mod integer, parameter :: gex_name = 1 !< internal index for gex_name integer, parameter :: gex_units = 2 !< internal index for gex unit - !> @brief This type represents the entries for a specific exchanged field !> @ingroup gex_mod type gex_type - character(fm_field_name_len):: name = '' - character(fm_string_len) :: units = '' - logical :: set = .FALSE. + character(fm_field_name_len):: name = '' !< gex name + character(fm_string_len) :: units = '' !< units (optional) end type gex_type + !> @brief This type stores information about all the exchanged fields !> @ingroup gex_mod type gex_type_r @@ -68,10 +135,10 @@ module gex_mod integer, allocatable :: n_gex(:,:) type(gex_type_r), allocatable :: gex_fields(:,:) +!> @addtogroup gex_mod +!> @{ contains -!> @addtogroup gex_mod - !> @{ !> @brief Subroutine to initialize generic exchange between model components subroutine gex_init() @@ -90,9 +157,10 @@ subroutine gex_init() write(*,*) '' end if - call gex_read_field_table('/coupler_mod/atm_to_lnd_ex',MODEL_ATMOS,MODEL_LAND) call gex_read_field_table('/coupler_mod/lnd_to_atm_ex',MODEL_LAND,MODEL_ATMOS) + call gex_read_field_table('/coupler_mod/atm_to_ocn_ex',MODEL_ATMOS,MODEL_OCEAN) + call gex_read_field_table('/coupler_mod/ocn_to_atm_ex',MODEL_OCEAN,MODEL_ATMOS) if (mpp_pe()==mpp_root_pe()) then write(*,*) '' @@ -107,21 +175,20 @@ end subroutine gex_init !> @brief Subroutine to fields for a given exchange subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) - character(len=*), intent(in) :: listroot ! name of the field manager list - integer, intent(in) :: MODEL_SRC ! index of the model where the tracer comes FROM - integer, intent(in) :: MODEL_REC ! index of the model where the tracer goes TO + character(len=*), intent(in) :: listroot !< name of the field manager list + integer, intent(in) :: MODEL_SRC !< index of the model where the field comes FROM + integer, intent(in) :: MODEL_REC !< index of the model where the field goes TO type(fm_list_iter_type) :: iter ! iterator over the list of tracers character(fm_field_name_len) :: name = '' ! name of the tracer character(fm_type_name_len) :: ftype ! type of the field table entry (not used) -! character(fm_path_name_len) :: current_list ! storage for current location in the fiels manager tree character(fm_path_name_len) :: listname ! name of the field manager list for each tracer integer :: n if(.not.fm_dump_list(listroot, recursive=.TRUE.)) then call error_mesg('gex_read_field_table', & - 'Cannot dump field list "'//listroot//'". No additional field will be exchanged from land to atmosphere',& + 'Cannot dump field list "'//listroot//'". No additional field will be exchanged',& NOTE) return endif @@ -133,18 +200,6 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) do while (fm_loop_over_list(iter, name, ftype, n)) associate(fld=>gex_fields(MODEL_SRC,MODEL_REC)%field(n)) ! define a shorthand, to avoid very long expressions fld%name = trim(name) - fld%set = .FALSE. - - ! read parameters of the tracer - - ! I am not sure saving/restoring "current_list" is necessary: it seems to work - ! without it. I just left it here commented out - - ! save current filed manager list -! current_list = fm_get_current_list() -! if (current_list .eq. ' ') & -! call error_mesg(module_name,'Could not get the current list',FATAL) - ! switch to the list of tracer parameters listname = trim(listroot)//'/'//trim(name) if (.not.fm_change_list(listname)) then @@ -153,38 +208,33 @@ subroutine gex_read_field_table(listroot,MODEL_SRC,MODEL_REC) ! read parameters fld%units = fm_util_get_string('units', caller = module_name, default_value = '', scalar = .true.) ! other parameters can be read here, for example: - ! fld%molar_mass = get_spdata_real('molar_mass', caller = module_name, default_value=12.0, scalar=.true.) - - ! restore to the original list -! if (.not.fm_change_list(current_list)) then -! call error_mesg(module_name,'Cannot change fm list back to "'//trim(current_list)//'"', FATAL) -! endif if (mpp_pe()==mpp_root_pe()) write(*,*) listroot,n,& ' name="'//trim(fld%name)//'"', & ' units="'//trim(fld%units)//'"' end associate end do -end subroutine - +end subroutine gex_read_field_table !> @brief Function to return number of fields exchanged function gex_get_n_ex(MODEL_SRC,MODEL_REC) - integer, intent(in) :: MODEL_SRC, MODEL_REC - integer gex_get_n_ex + integer, intent(in) :: MODEL_SRC !< index of the model where the field comes FROM + integer, intent(in) :: MODEL_REC !< index of the model where the filed goes TO + integer :: gex_get_n_ex gex_get_n_ex = n_gex(MODEL_SRC,MODEL_REC) return +end function gex_get_n_ex -end function - -!> @brief Function to return name of field +!> @brief Function to return property value (string) function gex_get_property(MODEL_SRC,MODEL_REC,index,property) - integer, intent(in) :: MODEL_SRC, MODEL_REC,index - integer :: property + integer, intent(in) :: MODEL_SRC !< index of the model where the field comes FROM + integer, intent(in) :: MODEL_REC !< index of the model where the filed goes TO + integer, intent(in) :: index !< gex index + integer, intent(in) :: property !< requested property character(len=64) :: gex_get_property if (index.le.n_gex(MODEL_SRC,MODEL_REC)) then @@ -202,14 +252,14 @@ function gex_get_property(MODEL_SRC,MODEL_REC,index,property) return -end function +end function gex_get_property !> @brief Function to return index of exchanged field -function gex_get_index(MODEL_SRC,MODEL_REC,name,record) +function gex_get_index(MODEL_SRC,MODEL_REC,name) character(len=*), intent(in) :: name !< name of the tracer - integer, intent(in) :: MODEL_SRC, MODEL_REC - logical, intent(in), optional :: record !record that this exchanged has been found and will be set + integer, intent(in) :: MODEL_SRC !< index of the model where the field comes FROM + integer, intent(in) :: MODEL_REC !< index of the model where the filed goes TO integer :: i integer :: gex_get_index @@ -217,19 +267,8 @@ function gex_get_index(MODEL_SRC,MODEL_REC,name,record) gex_get_index = NO_TRACER do i = 1, n_gex(MODEL_SRC,MODEL_REC) - if (lowercase(trim(name)) == trim(gex_fields(MODEL_SRC,MODEL_REC)%field(i)%name))then + if (lowercase(trim(name)) == trim(gex_fields(MODEL_SRC,MODEL_REC)%field(i)%name)) then gex_get_index = i - - if (present(record)) then - if (record) then - gex_fields(MODEL_SRC,MODEL_REC)%field(i)%set = .TRUE. - end if - else - if (.not. gex_fields(MODEL_SRC,MODEL_REC)%field(i)%set) then - call error_mesg('flux_exchange|gex','requested flux was never set',FATAL) - end if - end if - exit endif enddo From 98b850132d675c90889ce69c05e387d0f91ae403 Mon Sep 17 00:00:00 2001 From: Fabien Paulot Date: Wed, 12 Feb 2025 10:54:31 -0500 Subject: [PATCH 12/12] remove ws --- coupler/gex.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/coupler/gex.F90 b/coupler/gex.F90 index 1ac89b79e..c74154a8d 100644 --- a/coupler/gex.F90 +++ b/coupler/gex.F90 @@ -55,7 +55,7 @@ !!Two things need to happen: !! !!- At initialization, obtain index of exchanged field via: -!! +!! !! GEX_INDEX = gex_get_index(SENDING_COMPONENT,RECEIVING_COMPONENT,GEX_NAME) !! !! Returns `NO_TRACER` if `gex_name` is not found @@ -91,7 +91,7 @@ !! !! gex_array(:,:,GEX_INDEX) !! -!! `gex array` is an array that contains all exchanged fields in the receiving component. +!! `gex array` is an array that contains all exchanged fields in the receiving component. !! It needs to be made available in the routine where the field of interest is needed !! !> @file