Skip to content

Commit

Permalink
Use a linked list for ofg registry
Browse files Browse the repository at this point in the history 
Replace marbl_output_for_GCM_single_register_type with
marbl_output_for_GCM_linked_list_type; array of former becomes a pointer to
latter. This will make it much easier to add a new output_for_GCM, simply copy
format of a block of code in create_registry() [and add entry to
marbl_output_for_GCM_indexing_type]
  • Loading branch information
@mnlevy1981
mnlevy1981 committed Feb 21, 2024
1 parent 89cf5b9 commit e23e71e
Show file tree
Hide file tree
Showing 2 changed files with 124 additions and 74 deletions.
37 changes: 23 additions & 14 deletions src/marbl_interface.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -779,6 +779,8 @@ subroutine add_output_for_GCM(this, num_elements, field_name, output_id, field_s
! Check the registry to see if field_name is provided from surface_flux_compute() or interior_tendency_compute()
! add it to the proper output_for_GCM type, or log a useful error message

use marbl_interface_public_types, only : marbl_output_for_GCM_linked_list_type

class (marbl_interface_class), intent(inout) :: this
character(len=*), intent(in) :: field_name
integer(int_kind), intent(in) :: num_elements
Expand All @@ -788,25 +790,32 @@ subroutine add_output_for_GCM(this, num_elements, field_name, output_id, field_s

character(len=*), parameter :: subname = 'marbl_interface:add_output_for_GCM'
character(len=char_len) :: log_message
integer :: m
type(marbl_output_for_GCM_linked_list_type), pointer :: registered_output

output_id = 0
field_source = ""

do m=1,size(this%output_for_gcm_registry%registered_outputs)
if (trim(field_name) == trim(this%output_for_gcm_registry%registered_outputs(m)%short_name)) then
if (.not. associated(this%output_for_gcm_registry%registered_outputs)) then
call this%StatusLog%log_error("No outputs for GCM have been registered!", subname)
return
end if

registered_output => this%output_for_gcm_registry%registered_outputs
do while (associated(registered_output))
if (trim(field_name) == trim(registered_output%short_name)) then
! err_message will be populated if this field is unavailable in current configuration
if (len_trim(this%output_for_gcm_registry%registered_outputs(m)%err_message) > 0) then
write(log_message, "(A,1X,A)") trim(field_name), trim(this%output_for_gcm_registry%registered_outputs(m)%err_message)
if (len_trim(registered_output%err_message) > 0) then
write(log_message, "(A,1X,A)") trim(field_name), trim(registered_output%err_message)
call this%StatusLog%log_error(log_message, subname)
return
end if
exit
end if
registered_output => registered_output%next
end do

! Abort if field_name was not registered
if (m > size(this%output_for_gcm_registry%registered_outputs)) then
if (.not. associated(this%output_for_gcm_registry%registered_outputs)) then
write(log_message, "(2A)") trim(field_name), " is not a valid output field name for the GCM"
call this%StatusLog%log_error(log_message, subname)
return
Expand All @@ -816,26 +825,26 @@ subroutine add_output_for_GCM(this, num_elements, field_name, output_id, field_s
call this%StatusLog%log_noerror(log_message, subname)

! Set field source, and then add output to appropriate output_for_GCM_type
field_source = trim(this%output_for_gcm_registry%registered_outputs(m)%field_source)
field_source = trim(registered_output%field_source)
if ( trim(field_source) == "surface_flux") then
call this%surface_flux_output%add_output(this%output_for_gcm_registry%registered_outputs(m)%short_name, &
this%output_for_gcm_registry%registered_outputs(m)%long_name, &
this%output_for_gcm_registry%registered_outputs(m)%units, &
call this%surface_flux_output%add_output(registered_output%short_name, &
registered_output%long_name, &
registered_output%units, &
num_elements, &
output_id, &
num_levels)
end if
if (trim(field_source) == "interior_tendency") then
call this%interior_tendency_output%add_output(this%output_for_gcm_registry%registered_outputs(m)%short_name, &
this%output_for_gcm_registry%registered_outputs(m)%long_name, &
this%output_for_gcm_registry%registered_outputs(m)%units, &
call this%interior_tendency_output%add_output(registered_output%short_name, &
registered_output%long_name, &
registered_output%units, &
num_elements, &
output_id, &
num_levels)
end if

! %id is a pointer to a member of either sfo_ind or ito_ind
this%output_for_gcm_registry%registered_outputs(m)%id = output_id
registered_output%id = output_id

end subroutine add_output_for_GCM

Expand Down
161 changes: 101 additions & 60 deletions src/marbl_interface_public_types.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,21 +120,23 @@ module marbl_interface_public_types

!*****************************************************************************

type, public :: marbl_output_for_GCM_single_register_type
type, public :: marbl_output_for_GCM_linked_list_type
character(len=char_len) :: short_name
character(len=char_len) :: long_name
character(len=char_len) :: units
character(len=char_len) :: field_source
character(len=char_len) :: err_message
integer(int_kind), pointer :: id
end type marbl_output_for_GCM_single_register_type
type(marbl_output_for_GCM_linked_list_type), pointer :: next => NULL()
end type marbl_output_for_GCM_linked_list_type

!*****************************************************************************

type, public :: marbl_output_for_GCM_registry_type
type(marbl_output_for_GCM_single_register_type), allocatable, dimension(:) :: registered_outputs
type(marbl_output_for_GCM_linked_list_type), pointer :: registered_outputs
contains
procedure, public :: create_registry
procedure, public :: add_registry_entry
end type marbl_output_for_GCM_registry_type

!*****************************************************************************
Expand Down Expand Up @@ -793,77 +795,116 @@ subroutine create_registry(this, conc_flux_units)
class(marbl_output_for_GCM_registry_type), intent(out) :: this
character(len=*), intent(in) :: conc_flux_units

integer, parameter :: ofg_cnt=5
integer :: ofg_ind_loc
character(len=char_len) :: err_message

! Defined outputs for the GCM are
! 1. O2 Flux
! 2. CO2 Flux
! 3. NHx Flux
! 4. Surface Chl
! 5. Total Chl
allocate(this%registered_outputs(ofg_cnt))

! Set error messages to empty strings
do ofg_ind_loc=1,ofg_cnt
this%registered_outputs(ofg_ind_loc)%err_message = ""
end do
ofg_ind_loc = 0

! Register names and units of all outputs that can be provided to GCM

! Oxygen Flux
ofg_ind_loc = ofg_ind_loc + 1
this%registered_outputs(ofg_ind_loc)%short_name = "flux_o2"
this%registered_outputs(ofg_ind_loc)%long_name = "Oxygen Flux"
this%registered_outputs(ofg_ind_loc)%units = conc_flux_units
this%registered_outputs(ofg_ind_loc)%field_source = "surface_flux"
this%registered_outputs(ofg_ind_loc)%id => ofg_ind%flux_o2_id
if (.not. (base_bio_on .and. lflux_gas_o2)) &
this%registered_outputs(ofg_ind_loc)%err_message = "requires base biotic tracers and lflux_gas_o2"
if (.not. (base_bio_on .and. lflux_gas_o2)) then
err_message = "requires base biotic tracers and lflux_gas_o2"
else
err_message = ""
end if
call this%add_registry_entry(short_name = "flux_o2", &
long_name = "Oxygen Flux", &
units = conc_flux_units, &
field_source = "surface_flux", &
id = ofg_ind%flux_o2_id, &
err_message = err_message)

! Carbon Dioxide Flux
ofg_ind_loc = ofg_ind_loc + 1
this%registered_outputs(ofg_ind_loc)%short_name = "flux_co2"
this%registered_outputs(ofg_ind_loc)%long_name = "Carbon Dioxide Flux"
this%registered_outputs(ofg_ind_loc)%units = conc_flux_units
this%registered_outputs(ofg_ind_loc)%field_source = "surface_flux"
this%registered_outputs(ofg_ind_loc)%id => ofg_ind%flux_co2_id
if (.not. (base_bio_on .and. lflux_gas_co2)) &
this%registered_outputs(ofg_ind_loc)%err_message = "requires base biotic tracers and lflux_gas_co2"
if (.not. (base_bio_on .and. lflux_gas_co2)) then
err_message = "requires base biotic tracers and lflux_gas_co2"
else
err_message = ""
end if
call this%add_registry_entry(short_name = "flux_co2", &
long_name = "Carbon Dioxide Flux", &
units = conc_flux_units, &
field_source = "surface_flux", &
id = ofg_ind%flux_co2_id, &
err_message = err_message)

! NHx Surface Emissions
ofg_ind_loc = ofg_ind_loc + 1
this%registered_outputs(ofg_ind_loc)%short_name = "flux_nhx"
this%registered_outputs(ofg_ind_loc)%long_name = "NHx Surface Emissions"
this%registered_outputs(ofg_ind_loc)%units = conc_flux_units
this%registered_outputs(ofg_ind_loc)%field_source = "surface_flux"
this%registered_outputs(ofg_ind_loc)%id => ofg_ind%flux_nhx_id
if (.not. (base_bio_on .and. lcompute_nhx_surface_emis)) &
this%registered_outputs(ofg_ind_loc)%err_message = "requires base biotic tracers and lcompute_nhx_surface_emis"
if (.not. (base_bio_on .and. lcompute_nhx_surface_emis)) then
err_message = "requires base biotic tracers and lcompute_nhx_surface_emis"
else
err_message = ""
end if
call this%add_registry_entry(short_name = "flux_nhx", &
long_name = "NHx Surface Emissions", &
units = conc_flux_units, &
field_source = "surface_flux", &
id = ofg_ind%flux_nhx_id, &
err_message = err_message)

! Surface Chlorophyll
ofg_ind_loc = ofg_ind_loc + 1
this%registered_outputs(ofg_ind_loc)%short_name = "total_surfChl"
this%registered_outputs(ofg_ind_loc)%long_name = "Total Surface Chlorophyll Concentration"
this%registered_outputs(ofg_ind_loc)%units = "mg/m^3"
this%registered_outputs(ofg_ind_loc)%field_source = "surface_flux"
this%registered_outputs(ofg_ind_loc)%id => ofg_ind%total_surfChl_id
if (.not. base_bio_on) &
this%registered_outputs(ofg_ind_loc)%err_message = "requires base biotic tracers"
if (.not. base_bio_on) then
err_message = "requires base biotic tracers"
else
err_message = ""
end if
call this%add_registry_entry(short_name = "total_surfChl", &
long_name = "Total Surface Chlorophyll Concentration", &
units = "mg/m^3", &
field_source = "surface_flux", &
id = ofg_ind%total_surfChl_id, &
err_message = err_message)

! Full Depth Chlorophyll
ofg_ind_loc = ofg_ind_loc + 1
this%registered_outputs(ofg_ind_loc)%short_name = "total_Chl"
this%registered_outputs(ofg_ind_loc)%long_name = "Total Chlorophyll Concentration"
this%registered_outputs(ofg_ind_loc)%units = "mg/m^3"
this%registered_outputs(ofg_ind_loc)%field_source = "interior_tendency"
this%registered_outputs(ofg_ind_loc)%id => ofg_ind%total_Chl_id
if (.not. base_bio_on) &
this%registered_outputs(ofg_ind_loc)%err_message = "requires base biotic tracers"
if (.not. base_bio_on) then
err_message = "requires base biotic tracers"
else
err_message = ""
end if
call this%add_registry_entry(short_name = "total_Chl", &
long_name = "Total Chlorophyll Concentration", &
units = "mg/m^3", &
field_source = "interior_tendency", &
id = ofg_ind%total_Chl_id, &
err_message = err_message)

end subroutine create_registry

!***********************************************************************

subroutine add_registry_entry(this, short_name, long_name, units, field_source, id, err_message)
class(marbl_output_for_GCM_registry_type), intent(inout) :: this
character(len=*), intent(in) :: short_name
character(len=*), intent(in) :: long_name
character(len=*), intent(in) :: units
character(len=*), intent(in) :: field_source
integer, target, intent(in) :: id
character(len=*), optional, intent(in) :: err_message

type(marbl_output_for_GCM_linked_list_type), pointer :: new_entry

! Find last linked list item
if (associated(this%registered_outputs)) then
new_entry => this%registered_outputs
do while (associated(new_entry%next))
new_entry => new_entry%next
end do
allocate(new_entry%next)
new_entry => new_entry%next
else
! This is first entry in the registry
allocate(new_entry)
this%registered_outputs => new_entry
end if

new_entry%short_name = short_name
new_entry%long_name = long_name
new_entry%units = units
new_entry%field_source = field_source
new_entry%id => id
if (present(err_message)) then
new_entry%err_message = err_message
else
new_entry%err_message = ""
end if

end subroutine add_registry_entry

!***********************************************************************

end module marbl_interface_public_types

0 comments on commit e23e71e

Please sign in to comment.