From 23b1a0da505e70f7d22eb0fc3416190d24b520aa Mon Sep 17 00:00:00 2001 From: Nicholas Hannah Date: Mon, 11 May 2015 07:12:46 -0700 Subject: [PATCH] Changes to the diag mediator: 1. Renaming of 'diag' variable to 'diag_cs', to avoid confusion with a new diag type to be introduced. 2. Support dynamically sized diagnostic array. 3. Introduce a generalised concept of diagnostic 'variations'. Each primary diagnostic can have many variations or aliases that are registered and posted at the same time as the primary. An example of this is the CMOR diagnostics. Closes #171 --- src/framework/MOM_diag_mediator.F90 | 1130 +++++++++-------- .../lateral/MOM_hor_visc.F90 | 40 +- 2 files changed, 607 insertions(+), 563 deletions(-) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index c08cdb1606..a6d3ac850b 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -28,7 +28,7 @@ module MOM_diag_mediator !********+*********+*********+*********+*********+*********+*********+** use MOM_coms, only : PE_here -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : vardesc @@ -40,6 +40,7 @@ module MOM_diag_mediator use diag_manager_mod, only : send_data, diag_axis_init use diag_manager_mod, only : register_diag_field_fms=>register_diag_field use diag_manager_mod, only : register_static_field_fms=>register_static_field +use diag_manager_mod, only : DIAG_FIELD_NOT_FOUND implicit none ; private @@ -62,18 +63,25 @@ module MOM_diag_mediator character(len=15) :: id ! the id string for this particular combination of handles integer :: rank ! number of dimensions in the list of axes integer, dimension(:), allocatable :: handles ! Handles to 1D axes - type(diag_ctrl), pointer :: diag => null() + type(diag_ctrl), pointer :: diag_cs => null() end type axesType -! Type for vector of pointers to masks for either 2D or 3D data -type, private :: maskContainer - real,pointer, dimension(:,:) :: mask2d => null() - real,pointer, dimension(:,:,:) :: mask3d => null() -end type maskContainer - -! The following data type contains pointers to diagnostic fields that might -! be shared between modules, and to the variables that control the handling -! of model output. +! This type is used to represent a diagnostic at the diag_mediator level. +! There can be both 'primary' and 'seconday' diagnostics. The primaries +! reside in the diag_cs%diags array. They have an id which is an index +! into this array. The secondaries are 'variations' on the primary diagnostic. +! For example the CMOR diagnostics are secondary. The secondary diagnostics +! are kept in a list with the primary diagnostic as the head. +type, private :: diag_type + logical :: in_use + integer :: fms_diag_id ! underlying FMS diag id + real, pointer, dimension(:,:) :: mask2d => null() + real, pointer, dimension(:,:,:) :: mask3d => null() + type(diag_type), pointer :: next => null() ! pointer to the next diag +end type diag_type + +! The following data type a list of diagnostic fields an their variants, +! as well as variables that control the handling of model output. type, public :: diag_ctrl ! The following fields are used for the output of the data. @@ -105,11 +113,13 @@ module MOM_diag_mediator real, dimension(:,:,:), pointer :: mask3dCui => null() real, dimension(:,:,:), pointer :: mask3dCvi => null() -#define MAX_NUM_DIAGNOSTICS 2000 - type(maskContainer), dimension(MAX_NUM_DIAGNOSTICS) :: maskList - integer, dimension(MAX_NUM_DIAGNOSTICS) :: CMORid +! Space for diagnostics is dynamically allocated as it is needed. +! The chunk size is how much the array should grow on each new allocation. +#define DIAG_ALLOC_CHUNK_SIZE 100 + type(diag_type), dimension(:), allocatable :: diags + integer :: next_free_diag_id - !default missing value to be sent to ALL diagnostics registrations + !default missing value to be sent to ALL diagnostics registrations real :: missing_value = 1.0e+20 end type diag_ctrl @@ -118,17 +128,17 @@ module MOM_diag_mediator contains -subroutine set_axes_info(G, param_file, diag, set_vertical) +subroutine set_axes_info(G, param_file, diag_cs, set_vertical) type(ocean_grid_type), intent(inout) :: G type(param_file_type), intent(in) :: param_file - type(diag_ctrl), intent(inout) :: diag + type(diag_ctrl), intent(inout) :: diag_cs logical, optional, intent(in) :: set_vertical -! Arguments: +! Arguments: ! (inout) G - ocean grid structure. ! (in) param_file - structure indicating the open file to parse for ! model parameter values. -! (inout) diag - structure used to regulate diagnostic output. +! (inout) diag_cs - structure used to regulate diagnostic output. ! (in,opt) set_vertical - If true (or missing), set up the vertical axes. integer :: id_xq, id_yq, id_zl, id_zi, id_xh, id_yh, k, nz @@ -210,32 +220,32 @@ subroutine set_axes_info(G, param_file, diag, set_vertical) endif ! Vertical axes for the interfaces and layers - call defineAxes(diag, (/ id_zi /), diag%axesZi) - call defineAxes(diag, (/ id_zL /), diag%axesZL) + call defineAxes(diag_cs, (/ id_zi /), diag_cs%axesZi) + call defineAxes(diag_cs, (/ id_zL /), diag_cs%axesZL) ! Axis groupings for the model layers - call defineAxes(diag, (/ id_xh, id_yh, id_zL /), diag%axesTL) - call defineAxes(diag, (/ id_xq, id_yq, id_zL /), diag%axesBL) - call defineAxes(diag, (/ id_xq, id_yh, id_zL /), diag%axesCuL) - call defineAxes(diag, (/ id_xh, id_yq, id_zL /), diag%axesCvL) + call defineAxes(diag_cs, (/ id_xh, id_yh, id_zL /), diag_cs%axesTL) + call defineAxes(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%axesBL) + call defineAxes(diag_cs, (/ id_xq, id_yh, id_zL /), diag_cs%axesCuL) + call defineAxes(diag_cs, (/ id_xh, id_yq, id_zL /), diag_cs%axesCvL) ! Axis groupings for the model interfaces - call defineAxes(diag, (/ id_xh, id_yh, id_zi /), diag%axesTi) - call defineAxes(diag, (/ id_xq, id_yh, id_zi /), diag%axesCui) - call defineAxes(diag, (/ id_xh, id_yq, id_zi /), diag%axesCvi) - call defineAxes(diag, (/ id_xq, id_yq, id_zi /), diag%axesBi) + call defineAxes(diag_cs, (/ id_xh, id_yh, id_zi /), diag_cs%axesTi) + call defineAxes(diag_cs, (/ id_xq, id_yh, id_zi /), diag_cs%axesCui) + call defineAxes(diag_cs, (/ id_xh, id_yq, id_zi /), diag_cs%axesCvi) + call defineAxes(diag_cs, (/ id_xq, id_yq, id_zi /), diag_cs%axesBi) ! Axis groupings for 2-D arrays - call defineAxes(diag, (/ id_xh, id_yh /), diag%axesT1) - call defineAxes(diag, (/ id_xq, id_yq /), diag%axesB1) - call defineAxes(diag, (/ id_xq, id_yh /), diag%axesCu1) - call defineAxes(diag, (/ id_xh, id_yq /), diag%axesCv1) + call defineAxes(diag_cs, (/ id_xh, id_yh /), diag_cs%axesT1) + call defineAxes(diag_cs, (/ id_xq, id_yq /), diag_cs%axesB1) + call defineAxes(diag_cs, (/ id_xq, id_yh /), diag_cs%axesCu1) + call defineAxes(diag_cs, (/ id_xh, id_yq /), diag_cs%axesCv1) end subroutine set_axes_info -subroutine defineAxes(diag, handles, axes) +subroutine defineAxes(diag_cs, handles, axes) ! Defines "axes" from list of handle and associates mask - type(diag_ctrl), target, intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag_cs integer, dimension(:), intent(in) :: handles type(axesType), intent(out) :: axes @@ -247,54 +257,29 @@ subroutine defineAxes(diag, handles, axes) axes%id = i2s(handles, n) ! Identifying string axes%rank = n axes%handles(:) = handles(:) - axes%diag => diag ! A [circular] link back to the diag_ctrl structure + axes%diag_cs => diag_cs ! A [circular] link back to the diag_cs structure end subroutine defineAxes - -subroutine set_diag_mediator_grid(G, diag) +subroutine set_diag_mediator_grid(G, diag_cs) type(ocean_grid_type), intent(inout) :: G - type(diag_ctrl), intent(inout) :: diag + type(diag_ctrl), intent(inout) :: diag_cs ! Arguments: ! (inout) G - ocean grid structure ! (inout) diag - structure used to regulate diagnostic output - diag%is = G%isc - (G%isd-1) ; diag%ie = G%iec - (G%isd-1) - diag%js = G%jsc - (G%jsd-1) ; diag%je = G%jec - (G%jsd-1) - diag%isd = G%isd ; diag%ied = G%ied ; diag%jsd = G%jsd ; diag%jed = G%jed + diag_cs%is = G%isc - (G%isd-1) ; diag_cs%ie = G%iec - (G%isd-1) + diag_cs%js = G%jsc - (G%jsd-1) ; diag_cs%je = G%jec - (G%jsd-1) + diag_cs%isd = G%isd ; diag_cs%ied = G%ied + diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed end subroutine set_diag_mediator_grid -subroutine post_data_0d(diag_field_id, field, diag, is_static, mask) +subroutine post_data_0d(diag_field_id, field, diag_cs, is_static, mask) integer, intent(in) :: diag_field_id real, intent(in) :: field - type(diag_ctrl), intent(in) :: diag - logical, optional, intent(in) :: is_static - real, optional, intent(in) :: mask(:,:) - -! Arguments: -! (in) diag_field_id - id for an output variable returned by a -! previous call to register_diag_field -! (in) field - 0-d array being offered for output or averaging -! (inout) diag - structure used to regulate diagnostic output -! (in,opt) is_static - If true, this is a static field that is always offered. -! (in,opt) mask - If present, use this real array as the data mask. - - integer :: altId - - call post_data_0d_low(diag_field_id, field, diag, is_static, mask) - - ! for CMOR output - altId = diag%CMORid(diag_field_id) - if (altid>0) call post_data_0d_low(altId, field, diag, is_static, mask) - -end subroutine post_data_0d - -subroutine post_data_0d_low(diag_field_id, field, diag, is_static, mask) - integer, intent(in) :: diag_field_id - real, intent(in) :: field - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag_cs logical, optional, intent(in) :: is_static real, optional, intent(in) :: mask(:,:) @@ -302,108 +287,106 @@ subroutine post_data_0d_low(diag_field_id, field, diag, is_static, mask) ! (in) diag_field_id - the id for an output variable returned by a ! previous call to register_diag_field. ! (in) field - 0-d array being offered for output or averaging. -! (inout) diag - structure used to regulate diagnostic output. +! (inout) diag_cs - structure used to regulate diagnostic output. ! (in,opt) is_static - If true, this is a static field that is always offered. ! (in,opt) mask - If present, use this real array as the data mask. logical :: used, is_stat + type(diag_type), pointer :: diag => null() + + is_stat = .false. ; if (present(is_static)) is_stat = is_static + + ! Iterate over list of diag 'variants', e.g. CMOR aliases, call send_data + ! for each one. + call assert(diag_field_id < diag_cs%next_free_diag_id, & + 'post_data_0d: Unregistered diagnostic id') + diag => diag_cs%diags(diag_field_id) + do while (associated(diag)) + if (is_stat) then + used = send_data(diag%fms_diag_id, field) + elseif (diag_cs%ave_enabled) then + used = send_data(diag%fms_diag_id, field, diag_cs%time_end) + endif + diag => diag%next + enddo - is_stat = .false. ; if (present(is_static)) is_stat = is_static - - if (is_stat) then - used = send_data(diag_field_id, field) - elseif (diag%ave_enabled) then - used = send_data(diag_field_id, field, diag%time_end) - endif - -end subroutine post_data_0d_low - -subroutine post_data_1d_k(diag_field_id, field, diag, is_static) - integer, intent(in) :: diag_field_id - real, intent(in) :: field(:) - type(diag_ctrl), intent(in) :: diag - logical, optional, intent(in) :: is_static - -! Arguments: -! (in) diag_field_id - id for an output variable returned by a -! previous call to register_diag_field. -! (in) field - 3-d array being offered for output or averaging. -! (inout) diag - structure used to regulate diagnostic output. -! (in) static - If true, this is a static field that is always offered. - - integer :: altId - - call post_data_1d_k_low(diag_field_id, field, diag, is_static) - altId = diag%CMORid(diag_field_id) - if (altId>0) then - call post_data_1d_k_low(altId, field, diag, is_static) - endif - -end subroutine post_data_1d_k +end subroutine post_data_0d -subroutine post_data_1d_k_low(diag_field_id, field, diag, is_static) +subroutine post_data_1d_k(diag_field_id, field, diag_cs, is_static) integer, intent(in) :: diag_field_id real, intent(in) :: field(:) - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag_cs logical, optional, intent(in) :: is_static -! Arguments: +! Arguments: ! (in) diag_field_id - id for an output variable returned by a ! previous call to register_diag_field. ! (in) field - 3-d array being offered for output or averaging -! (inout) diag - structure used to regulate diagnostic output +! (inout) diag_cs - structure used to regulate diagnostic output ! (in) static - If true, this is a static field that is always offered. logical :: used ! The return value of send_data is not used for anything. logical :: is_stat integer :: isv, iev, jsv, jev + type(diag_type), pointer :: diag => null() + is_stat = .false. ; if (present(is_static)) is_stat = is_static - - if (is_stat) then - used = send_data(diag_field_id, field) - elseif (diag%ave_enabled) then - used = send_data(diag_field_id, field, diag%time_end, weight=diag%time_int) - endif -end subroutine post_data_1d_k_low + ! Iterate over list of diag 'variants', e.g. CMOR aliases. + call assert(diag_field_id < diag_cs%next_free_diag_id, & + 'post_data_1d_k: Unregistered diagnostic id') + diag => diag_cs%diags(diag_field_id) + do while (associated(diag)) + if (is_stat) then + used = send_data(diag%fms_diag_id, field) + elseif (diag_cs%ave_enabled) then + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, weight=diag_cs%time_int) + endif + diag => diag%next + enddo + +end subroutine post_data_1d_k -subroutine post_data_2d(diag_field_id, field, diag, is_static, mask) +subroutine post_data_2d(diag_field_id, field, diag_cs, is_static, mask) integer, intent(in) :: diag_field_id real, intent(in) :: field(:,:) - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag_cs logical, optional, intent(in) :: is_static real, optional, intent(in) :: mask(:,:) -! Arguments: +! Arguments: ! (in) diag_field_id - id for an output variable returned by a ! previous call to register_diag_field. ! (in) field - 2-d array being offered for output or averaging. -! (inout) diag - structure used to regulate diagnostic output. +! (inout) diag_cs - structure used to regulate diagnostic output. ! (in,opt) is_static - If true, this is a static field that is always offered. -! (in,opt) mask - If present, use this real array as the data mask. +! (in,opt) mask - If present, use this real array as the data mask. integer :: altId - - call post_data_2d_low(diag_field_id, field, diag, is_static, mask) - altId = diag%CMORid(diag_field_id) - if (altId>0) then - call post_data_2d_low(altId, field, diag, is_static, mask) - endif + type(diag_type), pointer :: diag => null() + + ! Iterate over list of diag 'variants' (e.g. CMOR aliases) and post each. + call assert(diag_field_id < diag_cs%next_free_diag_id, & + 'post_data_2d: Unregistered diagnostic id') + diag => diag_cs%diags(diag_field_id) + do while (associated(diag)) + call post_data_2d_low(diag, field, diag_cs, is_static, mask) + diag => diag%next + enddo end subroutine post_data_2d -subroutine post_data_2d_low(diag_field_id, field, diag, is_static, mask) - integer, intent(in) :: diag_field_id +subroutine post_data_2d_low(diag, field, diag_cs, is_static, mask) + type(diag_type), intent(in) :: diag real, intent(in) :: field(:,:) - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), intent(in) :: diag_cs logical, optional, intent(in) :: is_static real, optional, intent(in) :: mask(:,:) -! Arguments: -! (in) diag_field_id - id for an output variable returned by a -! previous call to register_diag_field. +! Arguments: +! (in) diag - structure representing the diagnostic to post ! (in) field - 2-d array being offered for output or averaging -! (inout) diag - structure used to regulate diagnostic output +! (inout) diag_cs - structure used to regulate diagnostic output ! (in,opt) is_static - If true, this is a static field that is always offered. ! (in,opt) mask - If present, use this real array as the data mask. @@ -417,27 +400,27 @@ subroutine post_data_2d_low(diag_field_id, field, diag, is_static, mask) ! but non-symmetric arrays are using a NE-grid indexing. Send_data ! actually only uses the difference between ie and is to determine ! the output data size and assumes that halos are symmetric. - isv = diag%is ; iev = diag%ie ; jsv = diag%js ; jev = diag%je - - if ( size(field,1) == diag%ied-diag%isd +1 ) then - isv = diag%is ; iev = diag%ie ! Data domain - elseif ( size(field,1) == diag%ied-diag%isd +2 ) then - isv = diag%is ; iev = diag%ie+1 ! Symmetric data domain - elseif ( size(field,1) == diag%ie-diag%is +1 ) then - isv = 1 ; iev = diag%ie + 1-diag%is ! Computational domain - elseif ( size(field,1) == diag%ie-diag%is +2 ) then - isv = 1 ; iev = diag%ie + 2-diag%is ! Symmetric computational domain + isv = diag_cs%is ; iev = diag_cs%ie ; jsv = diag_cs%js ; jev = diag_cs%je + + if ( size(field,1) == diag_cs%ied-diag_cs%isd +1 ) then + isv = diag_cs%is ; iev = diag_cs%ie ! Data domain + elseif ( size(field,1) == diag_cs%ied-diag_cs%isd +2 ) then + isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain + elseif ( size(field,1) == diag_cs%ie-diag_cs%is +1 ) then + isv = 1 ; iev = diag_cs%ie + 1-diag_cs%is ! Computational domain + elseif ( size(field,1) == diag_cs%ie-diag_cs%is +2 ) then + isv = 1 ; iev = diag_cs%ie + 2-diag_cs%is ! Symmetric computational domain else call MOM_error(FATAL,"post_data_2d_low: peculiar size in i-direction") endif - if ( size(field,2) == diag%jed-diag%jsd +1 ) then - jsv = diag%js ; jev = diag%je ! Data domain - elseif ( size(field,2) == diag%jed-diag%jsd +2 ) then - jsv = diag%js ; jev = diag%je+1 ! Symmetric data domain - elseif ( size(field,2) == diag%je-diag%js +1 ) then - jsv = 1 ; jev = diag%je + 1-diag%js ! Computational domain - elseif ( size(field,1) == diag%je-diag%js +2 ) then - jsv = 1 ; jev = diag%je + 2-diag%js ! Symmetric computational domain + if ( size(field,2) == diag_cs%jed-diag_cs%jsd +1 ) then + jsv = diag_cs%js ; jev = diag_cs%je ! Data domain + elseif ( size(field,2) == diag_cs%jed-diag_cs%jsd +2 ) then + jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain + elseif ( size(field,2) == diag_cs%je-diag_cs%js +1 ) then + jsv = 1 ; jev = diag_cs%je + 1-diag_cs%js ! Computational domain + elseif ( size(field,1) == diag_cs%je-diag_cs%js +2 ) then + jsv = 1 ; jev = diag_cs%je + 2-diag_cs%js ! Symmetric computational domain else call MOM_error(FATAL,"post_data_2d_low: peculiar size in j-direction") endif @@ -452,41 +435,41 @@ subroutine post_data_2d_low(diag_field_id, field, diag, is_static, mask) if (is_stat) then if (present(mask)) then - used = send_data(diag_field_id, field, & + used = send_data(diag%fms_diag_id, field, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) - !elseif(associated(diag%maskList(diag_field_id)%mask2d)) then - ! used = send_data(diag_field_id, field, & - ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%maskList(diag_field_id)%mask2d) + !elseif(associated(diag%mask2d)) then + ! used = send_data(diag%fms_diag_id, field, & + ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask2d) else - used = send_data(diag_field_id, field, & + used = send_data(diag%fms_diag_id, field, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif - elseif (diag%ave_enabled) then + elseif (diag_cs%ave_enabled) then if (present(mask)) then - used = send_data(diag_field_id, field, diag%time_end, & + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int, rmask=mask) - elseif(associated(diag%maskList(diag_field_id)%mask2d)) then - used = send_data(diag_field_id, field, diag%time_end, & + weight=diag_cs%time_int, rmask=mask) + elseif(associated(diag%mask2d)) then + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int, rmask=diag%maskList(diag_field_id)%mask2d) + weight=diag_cs%time_int, rmask=diag%mask2d) else - used = send_data(diag_field_id, field, diag%time_end, & + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int) + weight=diag_cs%time_int) endif endif end subroutine post_data_2d_low -subroutine post_data_3d(diag_field_id, field, diag, is_static, mask) +subroutine post_data_3d(diag_field_id, field, diag_cs, is_static, mask) integer, intent(in) :: diag_field_id real, intent(in) :: field(:,:,:) - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), target, intent(in) :: diag_cs logical, optional, intent(in) :: is_static real, optional, intent(in) :: mask(:,:,:) -! Arguments: +! Arguments: ! (in) diag_field_id - id for an output variable returned by a ! previous call to register_diag_field. ! (in) field - 3-d array being offered for output or averaging @@ -495,61 +478,64 @@ subroutine post_data_3d(diag_field_id, field, diag, is_static, mask) ! (in,opt) mask - If present, use this real array as the data mask. integer :: altId - - call post_data_3d_low(diag_field_id, field, diag, is_static, mask) - altId = diag%CMORid(diag_field_id) - if (altId>0) then - call post_data_3d_low(altId, field, diag, is_static, mask) - endif + type(diag_type), pointer :: diag => null() + + ! Iterate over list of diag 'variants', e.g. CMOR aliases. + call assert(diag_field_id < diag_cs%next_free_diag_id, & + 'post_data_3d: Unregistered diagnostic id') + diag => diag_cs%diags(diag_field_id) + do while (associated(diag)) + call post_data_3d_low(diag, field, diag_cs, is_static, mask) + diag => diag%next + enddo end subroutine post_data_3d -subroutine post_data_3d_low(diag_field_id, field, diag, is_static, mask) - integer, intent(in) :: diag_field_id +subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) + type(diag_type), intent(in) :: diag real, intent(in) :: field(:,:,:) - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), intent(in) :: diag_cs logical, optional, intent(in) :: is_static real, optional, intent(in) :: mask(:,:,:) -! Arguments: -! (in) diag_field_id - id for an output variable returned by a -! previous call to register_diag_field. +! Arguments: +! (in) diag - the diagnostic to post. ! (in) field - 3-d array being offered for output or averaging -! (inout) diag - structure used to regulate diagnostic output +! (inout) diag_cs - structure used to regulate diagnostic output ! (in) static - If true, this is a static field that is always offered. ! (in,opt) mask - If present, use this real array as the data mask. logical :: used ! The return value of send_data is not used for anything. logical :: is_stat integer :: isv, iev, jsv, jev - is_stat = .false. ; if (present(is_static)) is_stat = is_static - + is_stat = .false. ; if (present(is_static)) is_stat = is_static + ! Determine the proper array indices, noting that because of the (:,:) ! declaration of field, symmetric arrays are using a SW-grid indexing, ! but non-symmetric arrays are using a NE-grid indexing. Send_data ! actually only uses the difference between ie and is to determine ! the output data size and assumes that halos are symmetric. - isv = diag%is ; iev = diag%ie ; jsv = diag%js ; jev = diag%je - - if ( size(field,1) == diag%ied-diag%isd +1 ) then - isv = diag%is ; iev = diag%ie ! Data domain - elseif ( size(field,1) == diag%ied-diag%isd +2 ) then - isv = diag%is ; iev = diag%ie+1 ! Symmetric data domain - elseif ( size(field,1) == diag%ie-diag%is +1 ) then - isv = 1 ; iev = diag%ie + 1-diag%is ! Computational domain - elseif ( size(field,1) == diag%ie-diag%is +2 ) then - isv = 1 ; iev = diag%ie + 2-diag%is ! Symmetric computational domain + isv = diag_cs%is ; iev = diag_cs%ie ; jsv = diag_cs%js ; jev = diag_cs%je + + if ( size(field,1) == diag_cs%ied-diag_cs%isd +1 ) then + isv = diag_cs%is ; iev = diag_cs%ie ! Data domain + elseif ( size(field,1) == diag_cs%ied-diag_cs%isd +2 ) then + isv = diag_cs%is ; iev = diag_cs%ie+1 ! Symmetric data domain + elseif ( size(field,1) == diag_cs%ie-diag_cs%is +1 ) then + isv = 1 ; iev = diag_cs%ie + 1-diag_cs%is ! Computational domain + elseif ( size(field,1) == diag_cs%ie-diag_cs%is +2 ) then + isv = 1 ; iev = diag_cs%ie + 2-diag_cs%is ! Symmetric computational domain else call MOM_error(FATAL,"post_data_3d_low: peculiar size in i-direction") endif - if ( size(field,2) == diag%jed-diag%jsd +1 ) then - jsv = diag%js ; jev = diag%je ! Data domain - elseif ( size(field,2) == diag%jed-diag%jsd +2 ) then - jsv = diag%js ; jev = diag%je+1 ! Symmetric data domain - elseif ( size(field,2) == diag%je-diag%js +1 ) then - jsv = 1 ; jev = diag%je + 1-diag%js ! Computational domain - elseif ( size(field,1) == diag%je-diag%js +2 ) then - jsv = 1 ; jev = diag%je + 2-diag%js ! Symmetric computational domain + if ( size(field,2) == diag_cs%jed-diag_cs%jsd +1 ) then + jsv = diag_cs%js ; jev = diag_cs%je ! Data domain + elseif ( size(field,2) == diag_cs%jed-diag_cs%jsd +2 ) then + jsv = diag_cs%js ; jev = diag_cs%je+1 ! Symmetric data domain + elseif ( size(field,2) == diag_cs%je-diag_cs%js +1 ) then + jsv = 1 ; jev = diag_cs%je + 1-diag_cs%js ! Computational domain + elseif ( size(field,1) == diag_cs%je-diag_cs%js +2 ) then + jsv = 1 ; jev = diag_cs%je + 2-diag_cs%js ! Symmetric computational domain else call MOM_error(FATAL,"post_data_3d_low: peculiar size in j-direction") endif @@ -565,37 +551,37 @@ subroutine post_data_3d_low(diag_field_id, field, diag, is_static, mask) if (is_stat) then if (present(mask)) then - used = send_data(diag_field_id, field, & + used = send_data(diag%fms_diag_id, field, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=mask) - !elseif(associated(diag%maskList(diag_field_id)%mask3d)) then + !elseif(associated(diag%mask3d)) then ! used = send_data(diag_field_id, field, & - ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%maskList(diag_field_id)%mask3d) + ! is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, rmask=diag%mask3d) else - used = send_data(diag_field_id, field, & + used = send_data(diag%fms_diag_id, field, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev) endif - elseif (diag%ave_enabled) then + elseif (diag_cs%ave_enabled) then if (present(mask)) then - used = send_data(diag_field_id, field, diag%time_end, & + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int, rmask=mask) - elseif(associated(diag%maskList(diag_field_id)%mask3d)) then - used = send_data(diag_field_id, field, diag%time_end, & + weight=diag_cs%time_int, rmask=mask) + elseif(associated(diag%mask3d)) then + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int, rmask=diag%maskList(diag_field_id)%mask3d) + weight=diag_cs%time_int, rmask=diag%mask3d) else - used = send_data(diag_field_id, field, diag%time_end, & + used = send_data(diag%fms_diag_id, field, diag_cs%time_end, & is_in=isv, js_in=jsv, ie_in=iev, je_in=jev, & - weight=diag%time_int) + weight=diag_cs%time_int) endif endif end subroutine post_data_3d_low -subroutine enable_averaging(time_int_in, time_end_in, diag) +subroutine enable_averaging(time_int_in, time_end_in, diag_cs) real, intent(in) :: time_int_in type(time_type), intent(in) :: time_end_in - type(diag_ctrl), intent(inout) :: diag + type(diag_ctrl), intent(inout) :: diag_cs ! This subroutine enables the accumulation of time averages over the ! specified time interval. @@ -607,27 +593,27 @@ subroutine enable_averaging(time_int_in, time_end_in, diag) ! (inout) diag - structure used to regulate diagnostic output ! if (num_file==0) return - diag%time_int = time_int_in - diag%time_end = time_end_in - diag%ave_enabled = .true. + diag_cs%time_int = time_int_in + diag_cs%time_end = time_end_in + diag_cs%ave_enabled = .true. end subroutine enable_averaging ! Call this subroutine to avoid averaging any offered fields. -subroutine disable_averaging(diag) - type(diag_ctrl), intent(inout) :: diag +subroutine disable_averaging(diag_cs) + type(diag_ctrl), intent(inout) :: diag_cs ! Argument: ! diag - structure used to regulate diagnostic output - diag%time_int = 0.0 - diag%ave_enabled = .false. + diag_cs%time_int = 0.0 + diag_cs%ave_enabled = .false. end subroutine disable_averaging ! Call this subroutine to determine whether the averaging is ! currently enabled. .true. is returned if it is. -function query_averaging_enabled(diag, time_int, time_end) - type(diag_ctrl), intent(in) :: diag +function query_averaging_enabled(diag_cs, time_int, time_end) + type(diag_ctrl), intent(in) :: diag_cs real, optional, intent(out) :: time_int type(time_type), optional, intent(out) :: time_end logical :: query_averaging_enabled @@ -637,13 +623,13 @@ function query_averaging_enabled(diag, time_int, time_end) ! (out,opt) time_int - current setting of diag%time_int, in s ! (out,opt) time_end - current setting of diag%time_end - if (present(time_int)) time_int = diag%time_int - if (present(time_end)) time_end = diag%time_end - query_averaging_enabled = diag%ave_enabled + if (present(time_int)) time_int = diag_cs%time_int + if (present(time_end)) time_end = diag_cs%time_end + query_averaging_enabled = diag_cs%ave_enabled end function query_averaging_enabled -function get_diag_time_end(diag) - type(diag_ctrl), intent(in) :: diag +function get_diag_time_end(diag_cs) + type(diag_ctrl), intent(in) :: diag_cs type(time_type) :: get_diag_time_end ! Argument: @@ -652,13 +638,13 @@ function get_diag_time_end(diag) ! This function returns the valid end time for diagnostics that are handled ! outside of the MOM6 infrastructure, such as via the generic tracer code. - get_diag_time_end = diag%time_end + get_diag_time_end = diag_cs%time_end end function get_diag_time_end function register_diag_field(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & - cmor_long_name, cmor_units, cmor_standard_name, available) + cmor_long_name, cmor_units, cmor_standard_name) integer :: register_diag_field character(len=*), intent(in) :: module_name, field_name type(axesType), intent(in) :: axes @@ -671,10 +657,9 @@ function register_diag_field(module_name, field_name, axes, init_time, & integer, optional, intent(in) :: tile_count character(len=*), optional, intent(in) :: cmor_field_name, cmor_long_name character(len=*), optional, intent(in) :: cmor_units, cmor_standard_name - logical, optional, intent(in) :: available ! Output: An integer handle for a diagnostic array. - ! Arguments: + ! Arguments: ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model" ! (in) field_name - name of the diagnostic field ! (in) axes - container w/ up to 3 integer handles that indicates axes for this field @@ -698,185 +683,192 @@ function register_diag_field(module_name, field_name, axes, init_time, & ! (in,opt) interp_method - no clue ! (in,opt) tile_count - no clue - type(diag_ctrl), pointer :: diag - integer :: CMORid + real :: MOM_missing_value + type(diag_ctrl), pointer :: diag_cs + type(diag_type), pointer :: diag => null(), cmor_diag => null() + integer :: primary_id, fms_id character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name - register_diag_field = register_diag_field_low(module_name, field_name, axes, init_time, & - long_name=long_name, units=units, missing_value=missing_value, range=range, & - mask_variant=mask_variant, standard_name=standard_name, verbose=verbose, & - do_not_log=do_not_log, err_msg=err_msg, interp_method=interp_method, tile_count=tile_count, & - available=available) + MOM_missing_value = axes%diag_cs%missing_value + if(present(missing_value)) MOM_missing_value = missing_value + + diag_cs => axes%diag_cs + primary_id = -1 + diag => null() + cmor_diag => null() + + ! Set up the 'primary' diagnostic, first get an underlying FMS id + fms_id = register_diag_field_fms(module_name, field_name, axes%handles, & + init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & + interp_method=interp_method, tile_count=tile_count) + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + ! If the diagnostic is needed then allocate and id and space + primary_id = get_new_diag_id(diag_cs) + call alloc_diag_with_id(primary_id, diag_cs, diag) + call assert(associated(diag), 'register_diag_field: diag allocation failed') + diag%fms_diag_id = fms_id + call set_diag_mask(diag, diag_cs, axes) + endif - diag => axes%diag - CMORid = -1 + ! Set up the CMOR variation of the diagnostic if (present(cmor_field_name)) then ! Fallback values for strings set to "NULL" posted_cmor_units = "not provided" ! posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? posted_cmor_long_name = "not provided" ! - ! If attributes are present for MOM variable names, use them first for the register_diag_field + ! If attributes are present for MOM variable names, use them first for the register_diag_field ! call for CMOR verison of the variable if (present(units)) posted_cmor_units = units if (present(standard_name)) posted_cmor_standard_name = standard_name if (present(long_name)) posted_cmor_long_name = long_name - ! If specified in the call to register_diag_field, override attributes with the CMOR versions + ! If specified in the call to register_diag_field, override attributes with the CMOR versions if (present(cmor_units)) posted_cmor_units = cmor_units if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - CMORid = register_diag_field_low(module_name, cmor_field_name, axes, init_time, & + fms_id = register_diag_field_fms(module_name, cmor_field_name, axes%handles, init_time, & long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=missing_value, range=range, mask_variant=mask_variant, & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & - err_msg=err_msg, interp_method=interp_method, tile_count=tile_count, available=available) + err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) + + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + if (primary_id == -1) then + primary_id = get_new_diag_id(diag_cs) + endif + ! This will add the cmore variation to the 'primary' diagnostic. + ! In the case where there is no primary, it will become the primary. + call alloc_diag_with_id(primary_id, diag_cs, cmor_diag) + cmor_diag%fms_diag_id = fms_id + call set_diag_mask(cmor_diag, diag_cs, axes) + endif endif - ! If the diag_table contains both the normal field_name and CMOR name then we must - ! store both IDs - if (register_diag_field>0) then - diag%CMORid(register_diag_field) = CMORid - else ! but if only the CMOR name appears in the diag_table then just use that ID - register_diag_field = CMORid - if (CMORid>0) diag%CMORid(CMORid) = -1 + ! Set up any other variations here, e.g. remapped vertical dimension, + ! or decimation. + + ! Document diagnostics in list of available diagnostics + if (is_root_pe() .and. doc_unit > 0) then + call log_available_diag(associated(diag), module_name, field_name, & + long_name, units, standard_name) + if (present(cmor_field_name)) then + call log_available_diag(associated(cmor_diag), module_name, cmor_field_name, & + posted_cmor_long_name, posted_cmor_units, & + posted_cmor_standard_name) + endif endif + register_diag_field = primary_id + end function register_diag_field -function register_diag_field_low(module_name, field_name, axes, init_time, & +function register_scalar_field(module_name, field_name, init_time, diag_cs, & long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, available) - integer :: register_diag_field_low + verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & + cmor_long_name, cmor_units, cmor_standard_name) + integer :: register_scalar_field character(len=*), intent(in) :: module_name, field_name - type(axesType), intent(in) :: axes type(time_type), intent(in) :: init_time + type(diag_ctrl), intent(inout) :: diag_cs character(len=*), optional, intent(in) :: long_name, units, standard_name real, optional, intent(in) :: missing_value, range(2) logical, optional, intent(in) :: mask_variant, verbose, do_not_log character(len=*), optional, intent(out):: err_msg character(len=*), optional, intent(in) :: interp_method integer, optional, intent(in) :: tile_count - logical, optional, intent(in) :: available + character(len=*), optional, intent(in) :: cmor_field_name, cmor_long_name + character(len=*), optional, intent(in) :: cmor_units, cmor_standard_name ! Output: An integer handle for a diagnostic array. ! Arguments: - ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model" - ! (in) field_name - name of the diagnostic field - ! (in) axes - container with up to 3 integer handles that indicates axes for this field. + ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model". + ! (in) field_name - name of the diagnostic field. ! (in) init_time - time at which a field is first available? + ! (inout) diag_cs - structure used to regulate diagnostic output ! (in,opt) long_name - long name of a field ! (in,opt) units - units of a field - ! (in,opt) standard_name - standardized name associated with a field (not yet used in MOM). - ! (in,opt) missing_value - A value that indicates missing values + ! (in,opt) missing_value - indicates missing values + ! (in,opt) standard_name - standardized name associated with a field ! Following params have yet to be used in MOM. ! (in,opt) range - valid range of a variable ! (in,opt) mask_variant - If true a logical mask must be provided with post_data calls - ! (in,opt) verbose - If true, FMS is verbose + ! (in,opt) verbose - If true, FMS is verbosed ! (in,opt) do_not_log - If true, do not log something ! (out,opt) err_msg - character string into which an error message might be placed ! (in,opt) interp_method - no clue ! (in,opt) tile_count - no clue - character(len=240) :: mesg real :: MOM_missing_value - type(diag_ctrl), pointer :: diag - logical :: unavailable - - unavailable = .false. - if (present(available)) unavailable = .not. available + integer :: primary_id, fms_id + type(diag_type), pointer :: diag => null(), cmor_diag => null() + character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name - MOM_missing_value = axes%diag%missing_value + MOM_missing_value = diag_cs%missing_value if(present(missing_value)) MOM_missing_value = missing_value - register_diag_field_low = register_diag_field_fms(module_name, field_name, axes%handles, & - init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, mask_variant=mask_variant, standard_name=standard_name, & - verbose=verbose, do_not_log=do_not_log, err_msg=err_msg, & - interp_method=interp_method, tile_count=tile_count) - - ! Catch requests for diagnostics that are unavailable with this configuration - if (unavailable) then - if (register_diag_field_low>0) then - register_diag_field_low = -1 - call MOM_error(WARNING,'register_diag_field: Variable "'//trim(field_name)// & - '" is not available in this MOM6 configuration!') - endif - return ! Do nothing else in this function + primary_id = -1 + diag => null() + cmor_diag => null() + + fms_id = register_diag_field_fms(module_name, field_name, init_time, & + long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, standard_name=standard_name, do_not_log=do_not_log, err_msg=err_msg) + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + primary_id = get_new_diag_id(diag_cs) + call alloc_diag_with_id(primary_id, diag_cs, diag) + call assert(associated(diag), 'register_scalar_field: diag allocation failed') + diag%fms_diag_id = fms_id endif - ! Document in a list of available diagnostics - if (is_root_pe() .and. doc_unit > 0) then - if (register_diag_field_low > 0) then - mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Used]' - else - mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Unused]' - endif - write(doc_unit, '(a)') trim(mesg) - if (present(long_name)) call describe_option("long_name", long_name) - if (present(units)) call describe_option("units", units) - if (present(standard_name)) call describe_option("standard_name", standard_name) - endif + if (present(cmor_field_name)) then + ! Fallback values for strings set to "not provided" + posted_cmor_units = "not provided" + posted_cmor_standard_name = "not provided" + posted_cmor_long_name = "not provided" + + ! If attributes are present for MOM variable names, use them first for the register_static_field + ! call for CMOR verison of the variable + if (present(units)) posted_cmor_units = units + if (present(standard_name)) posted_cmor_standard_name = standard_name + if (present(long_name)) posted_cmor_long_name = long_name + + ! If specified in the call to register_static_field, override attributes with the CMOR versions + if (present(cmor_units)) posted_cmor_units = cmor_units + if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name + if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - !Decide what mask to use based on the axes info - if (register_diag_field_low>-1) then - !3d masks - if(axes%rank .eq. 3) then - diag => axes%diag - diag%maskList(register_diag_field_low)%mask2d => null() - diag%maskList(register_diag_field_low)%mask3d => null() - if (register_diag_field_low>MAX_NUM_DIAGNOSTICS) call MOM_error(FATAL, & - "MOM_diag_mediator, register_diag_field_low: " // & - "Too many diagnostics. Make MAX_NUM_DIAGNOSTICS bigger! "//trim(field_name)) - if (axes%id .eq. diag%axesTL%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dTL - elseif(axes%id .eq. diag%axesBL%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dBuL - elseif(axes%id .eq. diag%axesCuL%id ) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dCuL - elseif(axes%id .eq. diag%axesCvL%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dCvL - elseif(axes%id .eq. diag%axesTi%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dTi - elseif(axes%id .eq. diag%axesBi%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dBui - elseif(axes%id .eq. diag%axesCui%id ) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dCui - elseif(axes%id .eq. diag%axesCvi%id) then - diag%maskList(register_diag_field_low)%mask3d => diag%mask3dCvi -! else -! call MOM_error(FATAL, "MOM_diag_mediator:register_diag_field_low: " // & -! "unknown axes for diagnostic variable "//trim(field_name)) + fms_id = register_diag_field_fms(module_name, cmor_field_name, init_time, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, & + standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, err_msg=err_msg) + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + if (primary_id == -1) then + primary_id = get_new_diag_id(diag_cs) + endif + call alloc_diag_with_id(primary_id, diag_cs, cmor_diag) + cmor_diag%fms_diag_id = fms_id endif - !2d masks - elseif(axes%rank .eq. 2) then - diag => axes%diag - diag%maskList(register_diag_field_low)%mask2d => null() - diag%maskList(register_diag_field_low)%mask3d => null() - if (register_diag_field_low>MAX_NUM_DIAGNOSTICS) call MOM_error(FATAL, & - "MOM_diag_mediator, register_diag_field_low: " // & - "Too many diagnostics. Make MAX_NUM_DIAGNOSTICS bigger! "//trim(field_name)) - if (axes%id .eq. diag%axesT1%id) then - diag%maskList(register_diag_field_low)%mask2d => diag%mask2dT - elseif(axes%id .eq. diag%axesB1%id) then - diag%maskList(register_diag_field_low)%mask2d => diag%mask2dBu - elseif(axes%id .eq. diag%axesCu1%id) then - diag%maskList(register_diag_field_low)%mask2d => diag%mask2dCu - elseif(axes%id .eq. diag%axesCv1%id) then - diag%maskList(register_diag_field_low)%mask2d => diag%mask2dCv -! else -! call MOM_error(FATAL, "MOM_diag_mediator:register_diag_field_low: " // & -! "unknown axes for diagnostic variable "//trim(field_name)) + endif + + ! Document diagnostics in list of available diagnostics + if (is_root_pe() .and. doc_unit > 0) then + call log_available_diag(associated(diag), module_name, field_name, & + long_name, units, standard_name) + if (present(cmor_field_name)) then + call log_available_diag(associated(cmor_diag), module_name, cmor_field_name, & + posted_cmor_long_name, posted_cmor_units, & + posted_cmor_standard_name) endif - elseif(axes%rank .ne. 1) then - call MOM_error(FATAL, "MOM_diag_mediator:register_diag_field_low: " // & - "unknown axes for diagnostic variable "//trim(field_name)) endif - endif ! if (register_diag_field_low>-1) -end function register_diag_field_low + register_scalar_field = primary_id + +end function register_scalar_field function register_static_field(module_name, field_name, axes, & long_name, units, missing_value, range, mask_variant, standard_name, & @@ -910,110 +902,32 @@ function register_static_field(module_name, field_name, axes, & ! (in,opt) interp_method - no clue ! (in,opt) tile_count - no clue - character(len=240) :: mesg real :: MOM_missing_value - type(diag_ctrl), pointer :: diag - integer :: CMORid + type(diag_ctrl), pointer :: diag_cs + type(diag_type), pointer :: diag => null(), cmor_diag => null() + integer :: primary_id, fms_id, cmor_id character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name - MOM_missing_value = axes%diag%missing_value + MOM_missing_value = axes%diag_cs%missing_value if(present(missing_value)) MOM_missing_value = missing_value - register_static_field = register_static_field_fms(module_name, field_name, axes%handles, & - long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, mask_variant=mask_variant, standard_name=standard_name, & - do_not_log=do_not_log, & - interp_method=interp_method, tile_count=tile_count) - - diag => axes%diag - CMORid = -1 - if (present(cmor_field_name)) then - ! Fallback values for strings set to "not provided" - posted_cmor_units = "not provided" - posted_cmor_standard_name = "not provided" - posted_cmor_long_name = "not provided" - - ! If attributes are present for MOM variable names, use them first for the register_static_field - ! call for CMOR verison of the variable - if (present(units)) posted_cmor_units = units - if (present(standard_name)) posted_cmor_standard_name = standard_name - if (present(long_name)) posted_cmor_long_name = long_name - - ! If specified in the call to register_static_field, override attributes with the CMOR versions - if (present(cmor_units)) posted_cmor_units = cmor_units - if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name - if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - - CMORid = register_static_field_fms(module_name, cmor_field_name, axes%handles, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, & - interp_method=interp_method, tile_count=tile_count) - endif - - ! If the diag_table contains both the normal field_name and CMOR name then we must - ! store both IDs - if (register_static_field>0) then - diag%CMORid(register_static_field) = CMORid - else ! but if only the CMOR name appears in the diag_table then just use that ID - register_static_field = CMORid - if (CMORid>0) diag%CMORid(CMORid) = -1 + diag_cs => axes%diag_cs + primary_id = -1 + diag => null() + cmor_diag => null() + + fms_id = register_static_field_fms(module_name, field_name, axes%handles, & + long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, mask_variant=mask_variant, standard_name=standard_name, & + do_not_log=do_not_log, & + interp_method=interp_method, tile_count=tile_count) + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + primary_id = get_new_diag_id(diag_cs) + call alloc_diag_with_id(primary_id, diag_cs, diag) + call assert(associated(diag), 'register_static_field: diag allocation failed') + diag%fms_diag_id = fms_id endif -end function register_static_field - -function register_scalar_field(module_name, field_name, init_time, diag, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & - cmor_long_name, cmor_units, cmor_standard_name) - integer :: register_scalar_field - character(len=*), intent(in) :: module_name, field_name - type(time_type), intent(in) :: init_time - type(diag_ctrl), intent(inout) :: diag - character(len=*), optional, intent(in) :: long_name, units, standard_name - real, optional, intent(in) :: missing_value, range(2) - logical, optional, intent(in) :: mask_variant, verbose, do_not_log - character(len=*), optional, intent(out):: err_msg - character(len=*), optional, intent(in) :: interp_method - integer, optional, intent(in) :: tile_count - character(len=*), optional, intent(in) :: cmor_field_name, cmor_long_name - character(len=*), optional, intent(in) :: cmor_units, cmor_standard_name - - ! Output: An integer handle for a diagnostic array. - ! Arguments: - ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model". - ! (in) field_name - name of the diagnostic field. - ! (in) init_time - time at which a field is first available? - ! (inout) diag - structure used to regulate diagnostic output - ! (in,opt) long_name - long name of a field - ! (in,opt) units - units of a field - ! (in,opt) missing_value - indicates missing values - ! (in,opt) standard_name - standardized name associated with a field - - ! Following params have yet to be used in MOM. - ! (in,opt) range - valid range of a variable - ! (in,opt) mask_variant - If true a logical mask must be provided with post_data calls - ! (in,opt) verbose - If true, FMS is verbosed - ! (in,opt) do_not_log - If true, do not log something - ! (out,opt) err_msg - character string into which an error message might be placed - ! (in,opt) interp_method - no clue - ! (in,opt) tile_count - no clue - - character(len=240) :: mesg - real :: MOM_missing_value - integer :: CMORid - !type(diag_ctrl), pointer :: diag - character(len=256) :: posted_cmor_units, posted_cmor_standard_name, posted_cmor_long_name - - MOM_missing_value = diag%missing_value - if(present(missing_value)) MOM_missing_value = missing_value - - register_scalar_field = register_diag_field_fms(module_name, field_name, & - init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & - range=range, standard_name=standard_name, & - do_not_log=do_not_log, err_msg=err_msg) - - CMORid = -1 if (present(cmor_field_name)) then ! Fallback values for strings set to "not provided" posted_cmor_units = "not provided" @@ -1031,49 +945,23 @@ function register_scalar_field(module_name, field_name, init_time, diag, & if (present(cmor_standard_name)) posted_cmor_standard_name = cmor_standard_name if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name - CMORid = register_diag_field_fms(module_name, cmor_field_name, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, standard_name=trim(posted_cmor_standard_name), & - do_not_log=do_not_log, err_msg=err_msg) - endif - - ! If the diag_table contains both the normal field_name and CMOR name then we must - ! store both IDs - if (register_scalar_field>0) then - diag%CMORid(register_scalar_field) = CMORid - else ! but if only the CMOR name appears in the diag_table then just use that ID - register_scalar_field = CMORid - if (CMORid>0) diag%CMORid(CMORid) = -1 - endif - - if (is_root_pe() .and. doc_unit > 0) then - if (register_scalar_field > 0) then - mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Used]' - else - mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Unused]' - endif - write(doc_unit, '(a)') trim(mesg) - if (present(long_name)) call describe_option("long_name", long_name) - if (present(units)) call describe_option("units", units) - if (present(standard_name)) call describe_option("standard_name", standard_name) - endif - - if (present(cmor_field_name)) then - if (is_root_pe() .and. doc_unit > 0) then - if (CMORid > 0) then - mesg = '"'//trim(module_name)//'", "'//trim(cmor_field_name)//'" [Used]' - else - mesg = '"'//trim(module_name)//'", "'//trim(cmor_field_name)//'" [Unused]' - endif - write(doc_unit, '(a)') trim(mesg) - call describe_option("long_name", posted_cmor_long_name) - call describe_option("units", posted_cmor_units) - call describe_option("standard_name", posted_cmor_standard_name) + fms_id = register_static_field_fms(module_name, cmor_field_name, & + axes%handles, long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), do_not_log=do_not_log, & + interp_method=interp_method, tile_count=tile_count) + if (fms_id /= DIAG_FIELD_NOT_FOUND) then + if (primary_id == -1) then + primary_id = get_new_diag_id(diag_cs) + endif + call alloc_diag_with_id(primary_id, diag_cs, cmor_diag) + cmor_diag%fms_diag_id = fms_id endif endif -end function register_scalar_field + register_static_field = primary_id +end function register_static_field subroutine describe_option(opt_name, value) character(len=*), intent(in) :: opt_name, value @@ -1087,11 +975,11 @@ subroutine describe_option(opt_name, value) write(doc_unit, '(a)') trim(mesg) end subroutine describe_option -function ocean_register_diag(var_desc, G, diag, day) +function ocean_register_diag(var_desc, G, diag_cs, day) integer :: ocean_register_diag type(vardesc), intent(in) :: var_desc type(ocean_grid_type), intent(in) :: G - type(diag_ctrl), intent(in) :: diag + type(diag_ctrl), intent(in) :: diag_cs type(time_type), intent(in) :: day type(axesType) :: axes @@ -1103,23 +991,23 @@ function ocean_register_diag(var_desc, G, diag, day) case ("L") select case (var_desc%hor_grid) case ("q") - axes = diag%axesBL + axes = diag_cs%axesBL case ("h") - axes = diag%axesTL + axes = diag_cs%axesTL case ("u") - axes = diag%axesCuL + axes = diag_cs%axesCuL case ("v") - axes = diag%axesCvL + axes = diag_cs%axesCvL case ("Bu") - axes = diag%axesBL + axes = diag_cs%axesBL case ("T") - axes = diag%axesTL + axes = diag_cs%axesTL case ("Cu") - axes = diag%axesCuL + axes = diag_cs%axesCuL case ("Cv") - axes = diag%axesCvL + axes = diag_cs%axesCvL case ("z") - axes = diag%axeszL + axes = diag_cs%axeszL case default call MOM_error(FATAL, "ocean_register_diag: " // & "unknown hor_grid component "//trim(var_desc%hor_grid)) @@ -1128,23 +1016,23 @@ function ocean_register_diag(var_desc, G, diag, day) case ("i") select case (var_desc%hor_grid) case ("q") - axes = diag%axesBi + axes = diag_cs%axesBi case ("h") - axes = diag%axesTi + axes = diag_cs%axesTi case ("u") - axes = diag%axesCui + axes = diag_cs%axesCui case ("v") - axes = diag%axesCvi + axes = diag_cs%axesCvi case ("Bu") - axes = diag%axesBi + axes = diag_cs%axesBi case ("T") - axes = diag%axesTi + axes = diag_cs%axesTi case ("Cu") - axes = diag%axesCui + axes = diag_cs%axesCui case ("Cv") - axes = diag%axesCvi + axes = diag_cs%axesCvi case ("z") - axes = diag%axeszi + axes = diag_cs%axeszi case default call MOM_error(FATAL, "ocean_register_diag: " // & "unknown hor_grid component "//trim(var_desc%hor_grid)) @@ -1153,21 +1041,21 @@ function ocean_register_diag(var_desc, G, diag, day) case ("1") select case (var_desc%hor_grid) case ("q") - axes = diag%axesB1 + axes = diag_cs%axesB1 case ("h") - axes = diag%axesT1 + axes = diag_cs%axesT1 case ("u") - axes = diag%axesCu1 + axes = diag_cs%axesCu1 case ("v") - axes = diag%axesCv1 + axes = diag_cs%axesCv1 case ("Bu") - axes = diag%axesB1 + axes = diag_cs%axesB1 case ("T") - axes = diag%axesT1 + axes = diag_cs%axesT1 case ("Cu") - axes = diag%axesCu1 + axes = diag_cs%axesCu1 case ("Cv") - axes = diag%axesCv1 + axes = diag_cs%axesCv1 case default call MOM_error(FATAL, "ocean_register_diag: " // & "unknown hor_grid component "//trim(var_desc%hor_grid)) @@ -1184,16 +1072,16 @@ function ocean_register_diag(var_desc, G, diag, day) end function ocean_register_diag -subroutine diag_mediator_init(G, param_file, diag, err_msg) +subroutine diag_mediator_init(G, param_file, diag_cs, err_msg) type(ocean_grid_type), intent(inout) :: G type(param_file_type), intent(in) :: param_file - type(diag_ctrl), intent(inout) :: diag + type(diag_ctrl), intent(inout) :: diag_cs character(len=*), optional, intent(out) :: err_msg ! This subroutine initializes the diag_mediator and the diag_manager. ! The grid type should have its dimensions set by this point, but it ! is not necessary that the metrics and axis labels be set up yet. - integer :: ios + integer :: ios, i logical :: opened, new_file character(len=8) :: this_pe character(len=240) :: doc_file, doc_file_dflt @@ -1201,11 +1089,18 @@ subroutine diag_mediator_init(G, param_file, diag, err_msg) call diag_manager_init(err_msg=err_msg) - diag%is = G%isc - (G%isd-1) ; diag%ie = G%iec - (G%isd-1) - diag%js = G%jsc - (G%jsd-1) ; diag%je = G%jec - (G%jsd-1) - diag%isd = G%isd ; diag%ied = G%ied ; diag%jsd = G%jsd ; diag%jed = G%jed + ! Allocate and initialise list of all diagnostics (and variants) + allocate(diag_cs%diags(DIAG_ALLOC_CHUNK_SIZE)) + diag_cs%next_free_diag_id = 1 + do i=1, DIAG_ALLOC_CHUNK_SIZE + diag_cs%diags(i)%in_use = .false. + diag_cs%diags(i)%next => null() + enddo - diag%CMORid(:) = -1 + diag_cs%is = G%isc - (G%isd-1) ; diag_cs%ie = G%iec - (G%isd-1) + diag_cs%js = G%jsc - (G%jsd-1) ; diag_cs%je = G%jec - (G%jsd-1) + diag_cs%isd = G%isd ; diag_cs%ied = G%ied + diag_cs%jsd = G%jsd ; diag_cs%jed = G%jed if (is_root_pe()) then write(this_pe,'(i6.6)') PE_here() @@ -1241,44 +1136,44 @@ subroutine diag_mediator_init(G, param_file, diag, err_msg) end subroutine diag_mediator_init -subroutine diag_masks_set(G, missing_value, diag) +subroutine diag_masks_set(G, missing_value, diag_cs) ! Setup the 2d masks for diagnostics type(ocean_grid_type), target, intent(in) :: G real, intent(in) :: missing_value - type(diag_ctrl), pointer :: diag + type(diag_ctrl), pointer :: diag_cs ! Local variables integer :: k - diag%mask2dT => G%mask2dT - diag%mask2dBu=> G%mask2dBu - diag%mask2dCu=> G%mask2dCu - diag%mask2dCv=> G%mask2dCv - allocate(diag%mask3dTL(G%isd:G%ied,G%jsd:G%jed,1:G%ke)) - allocate(diag%mask3dBuL(G%IsdB:G%IedB,G%JsdB:G%JedB,1:G%ke)) - allocate(diag%mask3dCuL(G%IsdB:G%IedB,G%jsd:G%jed,1:G%ke)) - allocate(diag%mask3dCvL(G%isd:G%ied,G%JsdB:G%JedB,1:G%ke)) + diag_cs%mask2dT => G%mask2dT + diag_cs%mask2dBu=> G%mask2dBu + diag_cs%mask2dCu=> G%mask2dCu + diag_cs%mask2dCv=> G%mask2dCv + allocate(diag_cs%mask3dTL(G%isd:G%ied,G%jsd:G%jed,1:G%ke)) + allocate(diag_cs%mask3dBuL(G%IsdB:G%IedB,G%JsdB:G%JedB,1:G%ke)) + allocate(diag_cs%mask3dCuL(G%IsdB:G%IedB,G%jsd:G%jed,1:G%ke)) + allocate(diag_cs%mask3dCvL(G%isd:G%ied,G%JsdB:G%JedB,1:G%ke)) do k = 1,G%ke - diag%mask3dTL(:,:,k) = diag%mask2dT (:,:) - diag%mask3dBuL(:,:,k) = diag%mask2dBu(:,:) - diag%mask3dCuL(:,:,k) = diag%mask2dCu(:,:) - diag%mask3dCvL(:,:,k) = diag%mask2dCv(:,:) + diag_cs%mask3dTL(:,:,k) = diag_cs%mask2dT (:,:) + diag_cs%mask3dBuL(:,:,k) = diag_cs%mask2dBu(:,:) + diag_cs%mask3dCuL(:,:,k) = diag_cs%mask2dCu(:,:) + diag_cs%mask3dCvL(:,:,k) = diag_cs%mask2dCv(:,:) enddo - allocate(diag%mask3dTi(G%isd:G%ied,G%jsd:G%jed,1:G%ke+1)) - allocate(diag%mask3dBui(G%IsdB:G%IedB,G%JsdB:G%JedB,1:G%ke+1)) - allocate(diag%mask3dCui(G%IsdB:G%IedB,G%jsd:G%jed,1:G%ke+1)) - allocate(diag%mask3dCvi(G%isd:G%ied,G%JsdB:G%JedB,1:G%ke+1)) + allocate(diag_cs%mask3dTi(G%isd:G%ied,G%jsd:G%jed,1:G%ke+1)) + allocate(diag_cs%mask3dBui(G%IsdB:G%IedB,G%JsdB:G%JedB,1:G%ke+1)) + allocate(diag_cs%mask3dCui(G%IsdB:G%IedB,G%jsd:G%jed,1:G%ke+1)) + allocate(diag_cs%mask3dCvi(G%isd:G%ied,G%JsdB:G%JedB,1:G%ke+1)) do k = 1,G%ke+1 - diag%mask3dTi(:,:,k) = diag%mask2dT (:,:) - diag%mask3dBui(:,:,k) = diag%mask2dBu(:,:) - diag%mask3dCui(:,:,k) = diag%mask2dCu(:,:) - diag%mask3dCvi(:,:,k) = diag%mask2dCv(:,:) + diag_cs%mask3dTi(:,:,k) = diag_cs%mask2dT (:,:) + diag_cs%mask3dBui(:,:,k) = diag_cs%mask2dBu(:,:) + diag_cs%mask3dCui(:,:,k) = diag_cs%mask2dCu(:,:) + diag_cs%mask3dCvi(:,:,k) = diag_cs%mask2dCv(:,:) enddo - diag%missing_value = missing_value - + diag_cs%missing_value = missing_value + end subroutine diag_masks_set -subroutine diag_mediator_close_registration( ) +subroutine diag_mediator_close_registration() if (doc_unit > -1) then close(doc_unit) ; doc_unit = -2 @@ -1320,4 +1215,151 @@ function i2s(a,n_in) i2s = adjustl(i2s) end function i2s +subroutine set_diag_mask(diag, diag_cs, axes) + ! Associate a mask with the a diagnostic based on the axes info. + + type(diag_ctrl), intent(inout) :: diag_cs + type(diag_type), pointer, intent(out) :: diag + type(axesType), intent(in) :: axes + + if (axes%rank .eq. 3) then + diag%mask2d => null() + diag%mask3d => null() + if (axes%id .eq. diag_cs%axesTL%id) then + diag%mask3d => diag_cs%mask3dTL + elseif(axes%id .eq. diag_cs%axesBL%id) then + diag%mask3d => diag_cs%mask3dBuL + elseif(axes%id .eq. diag_cs%axesCuL%id ) then + diag%mask3d => diag_cs%mask3dCuL + elseif(axes%id .eq. diag_cs%axesCvL%id) then + diag%mask3d => diag_cs%mask3dCvL + elseif(axes%id .eq. diag_cs%axesTi%id) then + diag%mask3d => diag_cs%mask3dTi + elseif(axes%id .eq. diag_cs%axesBi%id) then + diag%mask3d => diag_cs%mask3dBui + elseif(axes%id .eq. diag_cs%axesCui%id ) then + diag%mask3d => diag_cs%mask3dCui + elseif(axes%id .eq. diag_cs%axesCvi%id) then + diag%mask3d => diag_cs%mask3dCvi + endif + + !call assert(associated(diag%mask3d), "MOM_diag_mediator.F90: Invalid 3d axes id") + elseif(axes%rank .eq. 2) then + diag%mask2d => null() + diag%mask3d => null() + if (axes%id .eq. diag_cs%axesT1%id) then + diag%mask2d => diag_cs%mask2dT + elseif(axes%id .eq. diag_cs%axesB1%id) then + diag%mask2d => diag_cs%mask2dBu + elseif(axes%id .eq. diag_cs%axesCu1%id) then + diag%mask2d => diag_cs%mask2dCu + elseif(axes%id .eq. diag_cs%axesCv1%id) then + diag%mask2d => diag_cs%mask2dCv + endif + + !call assert(associated(diag%mask2d), "MOM_diag_mediator.F90: Invalid 2d axes id") + endif + +end subroutine set_diag_mask + +! Allocate a new diagnostic id, it may be necessary to expand the diagnostics +! array. +function get_new_diag_id(diag_cs) + + integer :: get_new_diag_id + type(diag_ctrl), intent(inout) :: diag_cs + ! Arguments: + ! (inout) diag_cs - diagnostics control structure + + type(diag_type), dimension(:), allocatable :: tmp + integer :: i + + if (diag_cs%next_free_diag_id > size(diag_cs%diags)) then + call assert(diag_cs%next_free_diag_id - size(diag_cs%diags) == 1, & + 'get_new_diag_id: inconsistent diag id') + + ! Increase the size of diag_cs%diags and copy data over. + allocate(tmp(size(diag_cs%diags) + DIAG_ALLOC_CHUNK_SIZE)) + tmp(1:size(diag_cs%diags)) = diag_cs%diags + call move_alloc(tmp, diag_cs%diags) + call assert(size(diag_cs%diags) == size(tmp), & + 'get_new_diag_id: move_alloc() returned bad array size') + + ! Initialise new part of the diag array. + do i=diag_cs%next_free_diag_id, size(diag_cs%diags) + diag_cs%diags(i)%in_use = .false. + diag_cs%diags(i)%next => null() + enddo + endif + + get_new_diag_id = diag_cs%next_free_diag_id + diag_cs%next_free_diag_id = diag_cs%next_free_diag_id + 1 + +end function get_new_diag_id + +! Make a new diagnostic. Either use memory which is in the array of 'primary' +! diagnostics, or if that is in use, insert it to the list of secondary diags. +subroutine alloc_diag_with_id(diag_id, diag_cs, diag) + integer, intent(in) :: diag_id + type(diag_ctrl), target, intent(inout) :: diag_cs + type(diag_type), pointer, intent(out) :: diag + + ! Arguments: + ! (in) diag_id - new id for the diag. + ! (inout) diag_cs - structure used to regulate diagnostic output + ! (inout) diag - structure representing a diagnostic + + type(diag_type), pointer :: tmp + + if (.not. diag_cs%diags(diag_id)%in_use) then + diag => diag_cs%diags(diag_id) + else + allocate(diag) + tmp => diag_cs%diags(diag_id)%next + diag_cs%diags(diag_id)%next => diag + diag%next => tmp + endif + diag%in_use = .true. + +end subroutine alloc_diag_with_id + +! Log a diagnostic to the available diagnostics file. +subroutine log_available_diag(used, module_name, field_name, long_name, units, standard_name) + + logical, intent(in) :: used + character(len=*), intent(in) :: module_name, field_name + character(len=*), optional, intent(in) :: long_name, units, standard_name + character(len=240) :: mesg + + ! Arguments: + ! (in) used - whether or not this diagnostic is being used, i.e. appears in the diag_table + ! (in) module_name - name of this module, usually "ocean_model" or "ice_shelf_model". + ! (in) field_name - name of the diagnostic field + ! (in,opt) long_name - long name of a field + ! (in,opt) units - units of a field + ! (in,opt) standard_name - standardized name associated with a field + + if (used) then + mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Used]' + else + mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Unused]' + endif + write(doc_unit, '(a)') trim(mesg) + if (present(long_name)) call describe_option("long_name", long_name) + if (present(units)) call describe_option("units", units) + if (present(standard_name)) call describe_option("standard_name", standard_name) + +end subroutine log_available_diag + +subroutine assert(logical_arg, msg) + + logical, intent(in) :: logical_arg + character(len=*), intent(in) :: msg + + if (.not. logical_arg) then + call MOM_error(FATAL, msg) + endif + +end subroutine assert + end module MOM_diag_mediator diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index cfbbc83cb5..c95d7b9722 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1064,25 +1064,27 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & 'Meridional Acceleration from Horizontal Viscosity', 'meter second-2') - CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & - 'Biharmonic Horizontal Viscosity at h Points', 'meter4 second-1', & - available=CS%biharmonic, cmor_field_name='difmxybo', & - cmor_units='m4 s-1', cmor_long_name='Ocean lateral biharmonic viscosity',& - cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') - - CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & - 'Biharmonic Horizontal Viscosity at q Points', 'meter4 second-1', & - available=CS%biharmonic) - - CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & - 'Laplacian Horizontal Viscosity at h Points', 'meter2 second-1', & - available=CS%Laplacian, cmor_field_name='difmxylo', & - cmor_units='m2 s-1', cmor_long_name='Ocean lateral Laplacian viscosity',& - cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') - - CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & - 'Laplacian Horizontal Viscosity at q Points', 'meter2 second-1', & - available=CS%Laplacian) + if (CS%biharmonic) then + CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & + 'Biharmonic Horizontal Viscosity at h Points', 'meter4 second-1', & + cmor_field_name='difmxybo', cmor_units='m4 s-1', & + cmor_long_name='Ocean lateral biharmonic viscosity', & + cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') + + CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & + 'Biharmonic Horizontal Viscosity at q Points', 'meter4 second-1') + endif + + if (CS%Laplacian) then + CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & + 'Laplacian Horizontal Viscosity at h Points', 'meter2 second-1', & + cmor_field_name='difmxylo', cmor_units='m2 s-1', & + cmor_long_name='Ocean lateral Laplacian viscosity', & + cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') + + CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & + 'Laplacian Horizontal Viscosity at q Points', 'meter2 second-1') + endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& 'Integral work done by lateral friction terms', 'Watt meter-2')