diff --git a/CMakeLists.txt b/CMakeLists.txt index 773d83cbb4..17b128b02f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -304,7 +304,9 @@ foreach(kind ${kinds}) constants4 constants axis_utils/include - field_manager/include) + field_manager/include + tracer_manager/include) + target_compile_definitions(${libTgt}_f PRIVATE "${fms_defs}") target_compile_definitions(${libTgt}_f PRIVATE "${${kind}_defs}") @@ -347,7 +349,8 @@ foreach(kind ${kinds}) $ $ $ - $) + $ + $) target_include_directories(${libTgt} INTERFACE $ diff --git a/configure.ac b/configure.ac index 5321c2eb8e..e1c8c95160 100644 --- a/configure.ac +++ b/configure.ac @@ -480,6 +480,7 @@ AC_CONFIG_FILES([ test_fms/parser/Makefile test_fms/string_utils/Makefile test_fms/sat_vapor_pres/Makefile + test_fms/tracer_manager/Makefile test_fms/random_numbers/Makefile FMS.pc ]) diff --git a/test_fms/Makefile.am b/test_fms/Makefile.am index cc91905eb1..2b373b9340 100644 --- a/test_fms/Makefile.am +++ b/test_fms/Makefile.am @@ -26,7 +26,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. SUBDIRS = coupler diag_manager data_override exchange monin_obukhov drifters \ mosaic interpolator fms mpp mpp_io time_interp time_manager horiz_interp \ -field_manager axis_utils affinity fms2_io parser string_utils sat_vapor_pres \ +horiz_interp field_manager axis_utils affinity fms2_io parser string_utils sat_vapor_pres tracer_manager \ random_numbers # testing utility scripts to distribute diff --git a/test_fms/tracer_manager/Makefile.am b/test_fms/tracer_manager/Makefile.am new file mode 100644 index 0000000000..afe4159d7f --- /dev/null +++ b/test_fms/tracer_manager/Makefile.am @@ -0,0 +1,51 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** + +# This is an automake file for the test_fms/tracer_manager directory of +# the FMS package. + +# uramirez, Ed Hartnett + +# Find the needed mod files. +AM_CPPFLAGS = -I$(MODDIR) -I$(top_srcdir)/include + +# Link to the FMS library. +LDADD = $(top_builddir)/libFMS/libFMS.la + +# Build this test program. +check_PROGRAMS = test_tracer_manager_r4 test_tracer_manager_r8 + +# This is the source code for the test. +test_tracer_manager_r4_SOURCES = test_tracer_manager.F90 +test_tracer_manager_r8_SOURCES = test_tracer_manager.F90 + +test_tracer_manager_r4_CPPFLAGS=-DTEST_TM_KIND_=4 -I$(MODDIR) +test_tracer_manager_r8_CPPFLAGS=-DTEST_TM_KIND_=8 -I$(MODDIR) + +TEST_EXTENSIONS = .sh +SH_LOG_DRIVER = env AM_TAP_AWK='$(AWK)' $(SHELL) $(abs_top_srcdir)/test_fms/tap-driver.sh + +# Run the test program. +TESTS = test_tracer_manager2.sh + +# These files will also be included in the distribution. +EXTRA_DIST = test_tracer_manager2.sh + +# Clean up +CLEANFILES = input.nml *.out* field_table *.dpi *.spi *.dyn *.spl *.yaml diff --git a/test_fms/tracer_manager/test_tracer_manager.F90 b/test_fms/tracer_manager/test_tracer_manager.F90 new file mode 100644 index 0000000000..dbab8a5e2e --- /dev/null +++ b/test_fms/tracer_manager/test_tracer_manager.F90 @@ -0,0 +1,116 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** +!> @file +!! @brief unit test for set_tracer_profile function +!! @author MiKyung Lee +!! @email gfdl.climate.model.info@noaa.gov +!! @description This program only tests set_tracer_profile for cases where +!! profile_type is fixed; and for cases where profile_type is profile +!! TODO: Unit tests for the remaining subroutines and functions in tracer_manager_mod + +program test_tracer_manager + + use fms_mod, only: fms_init, fms_end + use mpp_mod, only: mpp_error, FATAL + use field_manager_mod, only: field_manager_init, MODEL_ATMOS, MODEL_OCEAN, MODEL_LAND, & + fm_change_list, fm_get_value, fm_get_current_list + use tracer_manager_mod + use platform_mod, only: r4_kind, r8_kind + + implicit none + + call fms_init + call test_set_tracer_profile + call fms_end + +contains + + subroutine test_set_tracer_profile + integer, parameter :: numlevels=10 + integer, parameter :: npoints=5 + + integer :: tracer_index, success, i, j, k + real(TEST_TM_KIND_) :: top_value, bottom_value, surf_value, multiplier + real(TEST_TM_KIND_) :: tracer_out1(1,1,1), tracer_out2(npoints,npoints,numlevels) + real(TEST_TM_KIND_) :: answer1(1,1,1), answer2(npoints,npoints,numlevels) + + integer, parameter :: lkind=TEST_TM_KIND_ + + character(128) :: err_message + + call fms_init + call tracer_manager_init + + !-- profile_type=fixed --! + + !> the tracer 'radon' profile type is 'fixed' (see field_table) + !> the tracer field value should be zero. + tracer_index=get_tracer_index(MODEL_ATMOS, 'radon') + call set_tracer_profile(MODEL_ATMOS, tracer_index, tracer_out1,err_message) + !> answer + answer1(1,1,1)=0.0_lkind + !> check results + if(tracer_out1(1,1,1).ne.answer1(1,1,1)) call mpp_error(FATAL,'ATM tracer field value should be 0.0') + + !-- ATM profile_type=profile --! + tracer_index=get_tracer_index(MODEL_ATMOS, 'immadeup') + call set_tracer_profile(MODEL_ATMOS,tracer_index,tracer_out2,err_message) + !> answer + success=fm_get_value("/atmos_mod/tracer/immadeup/profile_type/profile/top_value", top_value) + success=fm_get_value("/atmos_mod/tracer/immadeup/profile_type/profile/surface_value", surf_value) + multiplier = exp( log (top_value/surf_value) /real(numlevels-1,lkind) ) + answer2(:,:,1)=surf_value + do i=2,numlevels + answer2(:,:,i) = answer2(:,:,i-1)*multiplier + end do + !> check results + do k=1, numlevels + do j=1, npoints + do i=1, npoints + if( tracer_out2(i,j,k) .ne. answer2(i,j,k)) & + call mpp_error(FATAL, 'ATM tracer field value error for profile_type=profile') + end do + end do + end do + + !-- OCEAN profile_type=profile --! + tracer_index=get_tracer_index(MODEL_OCEAN, 'immadeup2') + call set_tracer_profile(MODEL_OCEAN,tracer_index,tracer_out2,err_message) + !> answer + success=fm_get_value("/ocean_mod/tracer/immadeup2/profile_type/profile/bottom_value", bottom_value) + success=fm_get_value("/ocean_mod/tracer/immadeup2/profile_type/profile/surface_value", surf_value) + multiplier = exp( log (bottom_value/surf_value) /real(numlevels-1,lkind)) + answer2(:,:,numlevels)=surf_value + do i=numlevels-1, 1, -1 + answer2(:,:,i) = answer2(:,:,i+1)*multiplier + end do + !> check results + do k=1, numlevels + do j=1, npoints + do i=1, npoints + if( tracer_out2(i,j,k) .ne. answer2(i,j,k)) & + call mpp_error(FATAL, 'OCEAN tracer field value error for profile_type=profile') + end do + end do + end do + + +end subroutine test_set_tracer_profile + +end program test_tracer_manager diff --git a/test_fms/tracer_manager/test_tracer_manager2.sh b/test_fms/tracer_manager/test_tracer_manager2.sh new file mode 100755 index 0000000000..cc39e363a0 --- /dev/null +++ b/test_fms/tracer_manager/test_tracer_manager2.sh @@ -0,0 +1,109 @@ +#!/bin/sh + +#*********************************************************************** +#* 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 . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/field_manager directory. + +# Ed Hartnett 11/29/19 + +# Set common test settings. +. ../test-lib.sh + +# Copy files for test. +cat <<_EOF > field_table +# Simplified field table to run the field table unit tests + "TRACER", "ocean_mod", "biotic1" + "diff_horiz", "linear", "slope=ok" + "longname", "biotic one" / + "TRACER", "ocean_mod", "age_ctl" / + "TRACER", "ocean_mod" "immadeup2" + "longname", "im_made_up2_for_testing" + "units", "atomic_units" + "profile_type", "profile", "surface_value=1.e-12,bottom_value=1.e-9"/ + "TRACER", "atmos_mod","radon" + "longname","radon-222" + "units","VMR*1E21" + "profile_type","fixed","surface_value=0.0E+00" + "convection","all"/ + "TRACER", "atmos_mod" "immadeup" + "longname", "im_made_up_for_testing" + "units", "hbar" + "profile_type", "profile", "surface_value=1.e-12,top_value=1.e-15"/ + "TRACER", "land_mod", "sphum" + "longname", "specific humidity" + "units", "kg/kg" / +_EOF + +cat <<_EOF > field_table.yaml +field_table: +- field_type: tracer + modlist: + - model_type: atmos_mod + varlist: + - variable: radon + longname: radon-222 + units: VMR*1E21 + profile_type: fixed + subparams: + - surface_value: 0.0e+00 + convection: all + - model_type: atmos_mod + varlist: + - variable: immadeup + longname: im_made_up_for_testing + units: hbar + profile_type: profile + subparams: + - surface_value: 1.02e-12 + top_value: 1.0e-15 + - model_type: ocean_mod + varlist: + - variable: biotic1 + diff_horiz: linear + subparams: + - slope: ok + longname: biotic one + - variable: age_ctl + - model_type: ocean_mod + varlist: + - variable: immadeup2 + longname: im_made_up2_for_testing + units: hbar + profile_type: profile + subparams: + - surface_value: 1.0e-12 + bottom_value: 1.0e-9 + - model_type: land_mod + varlist: + - variable: sphum + longname: specific humidity + units: kg/kg +_EOF + +cat <<_EOF > input.nml +&test_tracer_manager +/ +_EOF + +test_expect_success "tracer_manager r4" 'mpirun -n 2 ./test_tracer_manager_r4' +test_expect_success "tracer_manager r8" 'mpirun -n 2 ./test_tracer_manager_r8' + +test_done diff --git a/tracer_manager/Makefile.am b/tracer_manager/Makefile.am index f8469e67b9..476d86796d 100644 --- a/tracer_manager/Makefile.am +++ b/tracer_manager/Makefile.am @@ -23,17 +23,20 @@ # Ed Hartnett 2/22/19 # Include .h and .mod files. -AM_CPPFLAGS = -I$(top_srcdir)/include +AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/tracer_manager/include AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) # Build this uninstalled convenience library. noinst_LTLIBRARIES = libtracer_manager.la # The convenience library depends on its source. -libtracer_manager_la_SOURCES = tracer_manager.F90 +libtracer_manager_la_SOURCES = tracer_manager.F90 \ + include/tracer_manager.inc\ + include/tracer_manager_r4.fh\ + include/tracer_manager_r8.fh -BUILT_SOURCES = tracer_manager_mod.$(FC_MODEXT) +BUILT_SOURCES = tracer_manager_mod.$(FC_MODEXT) include/tracer_manager.inc include/tracer_manager_r4.fh include/tracer_manager_r8.fh nodist_include_HEADERS = tracer_manager_mod.$(FC_MODEXT) include $(top_srcdir)/mkmods.mk diff --git a/tracer_manager/include/tracer_manager.inc b/tracer_manager/include/tracer_manager.inc index 5c2321fce4..2954ec170d 100644 --- a/tracer_manager/include/tracer_manager.inc +++ b/tracer_manager/include/tracer_manager.inc @@ -18,993 +18,7 @@ !*********************************************************************** !> @defgroup tracer_manager_mod tracer_manager_mod !> @ingroup tracer_manager -!> @brief Code to manage the simple addition of tracers to the FMS code. -!! This code keeps track of the numbers and names of tracers included -!! in a tracer table. -!! -!> @author William Cooke -!! -!> This code is a grouping of calls which will allow the simple -!! introduction of tracers into the FMS framework. It is designed to -!! allow users of a variety of component models interact easily with -!! the dynamical core of the model. -!! -!! In calling the tracer manager routines the user must provide a -!! parameter identifying the model that the user is working with. This -!! parameter is defined within field_manager as MODEL_X -!! where X is one of [ATMOS, OCEAN, LAND, ICE]. -!! -!! In many of these calls the argument list includes model and tracer_index. These -!! are the parameter corresponding to the component model and the tracer_index N is -!! the Nth tracer within the component model. Therefore a call with MODEL_ATMOS and 5 -!! is different from a call with MODEL_OCEAN and 5. - -module tracer_manager_mod - -!---------------------------------------------------------------------- - -use mpp_mod, only : mpp_error, & - mpp_pe, & - mpp_root_pe, & - FATAL, & - WARNING, & - NOTE, & - stdlog -use fms_mod, only : lowercase, & - write_version_number - -use field_manager_mod, only : field_manager_init, & - get_field_info, & - get_field_methods, & - MODEL_ATMOS, & - MODEL_LAND, & - MODEL_OCEAN, & - MODEL_ICE, & - MODEL_COUPLER, & - NUM_MODELS, & - method_type, & - default_method, & - parse, & - fm_copy_list, & - fm_change_list, & - fm_modify_name, & - fm_query_method, & - fm_new_value, & - fm_exists, & - MODEL_NAMES - -implicit none -private - -!----------------------------------------------------------------------- - -public tracer_manager_init, & - tracer_manager_end, & - check_if_prognostic, & - get_tracer_indices, & - get_tracer_index, & - get_tracer_names, & - get_tracer_name, & - query_method, & - set_tracer_atts, & - set_tracer_profile, & - register_tracers, & - get_number_tracers, & - adjust_mass, & - adjust_positive_def, & - NO_TRACER, & - MAX_TRACER_FIELDS, & - set_tracer_method - -!> @brief Function which returns the number assigned to the tracer name. -!! -!> This is a function which returns the index, as implied within the component model. -!! There are two overloaded interfaces: one of type integer, one logical. -!! -!! @param model A integer parameter to identify which model is being used -!! @param name The name of the tracer (as assigned in the field table). -!! @param indices An array indices. When present, the returned index will limit the search for the -!! tracer to thos tracers whose indices are among those in array 'indices'. This would be useful -!! when it is desired to limit the search to a subset of the tracers. Such a subset might be the -!! diagnostic or prognostic tracers.(note that @ref get_tracer_indices returns these subsets) -!! @param verbose Optional flag for debugging -!! @param[out] index Holds the returned index if given -!! @returns The integer function returns the index of the tracer named "name". If no tracer by that -!! name exists then the returned value is NO_TRACER. The logical function returns false if no -!! tracer by the given name exists and true otherwise, and stores the returned value in index. -!! -!!
Example usage: -!! @code{.F90} -!! integer: -!! index = get_tracer_index(model, name, indices, verbose) -!! logical: -!! if ( get_tracer_index(model, name, index, indices, verbose) ) then -!! @endcode -!> @ingroup tracer_manager_mod -interface get_tracer_index - module procedure get_tracer_index_integer, get_tracer_index_logical -end interface - -!> Private type to hold metadata for a tracer -!> @ingroup tracer_manager_mod -type, private :: tracer_type - character(len=32) :: tracer_name, tracer_units - character(len=128) :: tracer_longname - integer :: num_methods, model, instances - logical :: is_prognostic, instances_set - logical :: needs_init -! Does tracer need mass or positive definite adjustment? -! (true by default for both) - logical :: needs_mass_adjust - logical :: needs_positive_adjust -end type tracer_type - -!> Private type to holds string data for a tracer -!> @ingroup tracer_manager_mod -type, private :: tracer_name_type - character(len=32) :: model_name, tracer_name, tracer_units - character(len=128) :: tracer_longname -end type tracer_name_type - -!> Private type to represent named instances -!> @ingroup tracer_manager_mod -type, private :: inst_type - character(len=128) :: name - integer :: instances -end type inst_type - -!> @addtogroup tracer_manager_mod -!> @{ - -integer :: num_tracer_fields = 0 -integer, parameter :: MAX_TRACER_FIELDS = 250 -integer, parameter :: MAX_TRACER_METHOD = 20 -integer, parameter :: NO_TRACER = 1-HUGE(1) -integer, parameter :: NOTRACER = -HUGE(1) - -type(tracer_type), save :: tracers(MAX_TRACER_FIELDS) -type(inst_type) , save :: instantiations(MAX_TRACER_FIELDS) - -integer :: total_tracers(NUM_MODELS), prog_tracers(NUM_MODELS), diag_tracers(NUM_MODELS) -logical :: model_registered(NUM_MODELS) = .FALSE. - -! Include variable "version" to be written to log file. -#include - -logical :: module_is_initialized = .false. - -logical :: verbose_local -integer :: TRACER_ARRAY(NUM_MODELS,MAX_TRACER_FIELDS) - -contains - -!####################################################################### - -!> @brief Not necessary to call, only needed for backward compatability. -!! -!> Writes version to logfile and sets init flag for this module -subroutine tracer_manager_init -integer :: model, num_tracers, num_prog, num_diag - - if(module_is_initialized) return - module_is_initialized = .TRUE. - - call write_version_number ("TRACER_MANAGER_MOD", version) - call field_manager_init() - TRACER_ARRAY = NOTRACER - do model=1,NUM_MODELS - call get_tracer_meta_data(model, num_tracers, num_prog, num_diag) - enddo - -end subroutine tracer_manager_init - -!> @brief Read in tracer table and store tracer information associated with "model" in "tracers" -!! array. -subroutine get_tracer_meta_data(model, num_tracers,num_prog,num_diag) - -integer, intent(in) :: model !< model being used -integer, intent(out) :: num_tracers, num_prog, num_diag -character(len=256) :: warnmesg - -character(len=32) :: name_type, type, name -integer :: n, m, mod, num_tracer_methods, nfields, swop -integer :: j, log_unit, num_methods -logical :: flag_type -type(method_type), dimension(MAX_TRACER_METHOD) :: methods -integer :: instances, siz_inst,i -character(len = 32) :: digit,suffnam - -character(len=128) :: list_name , control -integer :: index_list_name -logical :: fm_success - -! -! The index for the model type is invalid. -! -if (model .ne. MODEL_ATMOS .and. model .ne. MODEL_LAND .and. & - model .ne. MODEL_OCEAN .and. model .ne. MODEL_ICE .and. & - model .ne. MODEL_COUPLER) call mpp_error(FATAL,'tracer_manager_init : invalid model type') - -! One should only call get_tracer_meta_data once for each model type -! Therefore need to set up an array to stop the subroutine being -! unnecssarily called multiple times. - -if ( model_registered(model) ) then -! This routine has already been called for the component model. -! Fill in the values from the previous registration and return. - num_tracers = total_tracers(model) - num_prog = prog_tracers(model) - num_diag = diag_tracers(model) - return -endif - -! Initialize the number of tracers to zero. -num_tracers = 0; num_prog = 0; num_diag = 0 - -call field_manager_init(nfields=nfields) - -! -! No tracers are available to be registered. This means that the field -! table does not exist or is empty. -! -if (nfields == 0 ) then -if (mpp_pe() == mpp_root_pe()) & - call mpp_error(NOTE,'tracer_manager_init : No tracers are available to be registered.') - return -endif - -! search through field entries for model tracers -total_tracers(model) = 0 - -do n=1,nfields - call get_field_info(n,type,name,mod,num_methods) - - if (mod == model .and. type == 'tracer') then - num_tracer_fields = num_tracer_fields + 1 - total_tracers(model) = total_tracers(model) + 1 -! -! The maximum number of tracer fields has been exceeded. -! - if(num_tracer_fields > MAX_TRACER_FIELDS) call mpp_error(FATAL, & - & 'tracer_manager_init: MAX_TRACER_FIELDS exceeded') - TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields - tracers(num_tracer_fields)%model = model - tracers(num_tracer_fields)%tracer_name = name - tracers(num_tracer_fields)%tracer_units = 'none' - tracers(num_tracer_fields)%tracer_longname = tracers(num_tracer_fields)%tracer_name - tracers(num_tracer_fields)%instances_set = .FALSE. -! By default, tracers need mass and positive definite adjustments. -! We hardwire exceptions for compatibility with existing field_tables -! This should ideally be cleaned up. - tracers(num_tracer_fields)%needs_mass_adjust = .true. - tracers(num_tracer_fields)%needs_positive_adjust = .true. - if (name == 'cld_amt') then - tracers(num_tracer_fields)%needs_mass_adjust = .false. - endif - if (name == 'cld_amt' .or. name == 'liq_wat' .or. name == 'ice_wat') then - tracers(num_tracer_fields)%needs_positive_adjust = .false. - endif - - num_tracer_methods = 0 - methods = default_method ! initialize methods array - call get_field_methods(n,methods) - do j=1,num_methods - select case (methods(j)%method_type) - case ('units') - tracers(num_tracer_fields)%tracer_units = methods(j)%method_name - case ('longname') - tracers(num_tracer_fields)%tracer_longname = methods(j)%method_name - case ('instances') -! tracers(num_tracer_fields)%instances = methods(j)%method_name - siz_inst = parse(methods(j)%method_name,"",instances) - tracers(num_tracer_fields)%instances = instances - tracers(num_tracer_fields)%instances_set = .TRUE. - case ('adjust_mass') - if (methods(j)%method_name == "false") then - tracers(num_tracer_fields)%needs_mass_adjust = .false. - endif - case ('adjust_positive_def') - if (methods(j)%method_name == "false") then - tracers(num_tracer_fields)%needs_positive_adjust = .false. - endif - case default - num_tracer_methods = num_tracer_methods+1 -! tracers(num_tracer_fields)%methods(num_tracer_methods) = methods(j) - end select - enddo - tracers(num_tracer_fields)%num_methods = num_tracer_methods - tracers(num_tracer_fields)%needs_init = .false. - flag_type = query_method ('tracer_type',model,total_tracers(model),name_type) - if (flag_type .and. name_type == 'diagnostic') then - tracers(num_tracer_fields)%is_prognostic = .false. - else - tracers(num_tracer_fields)%is_prognostic = .true. - endif - if (tracers(num_tracer_fields)%is_prognostic) then - num_prog = num_prog+1 - else - num_diag = num_diag+1 - endif - endif -enddo - -! Now cycle through the tracers and add additional instances of the tracers. - -do n = 1, num_tracer_fields !{ -! call get_field_info(n,type,name,mod,num_methods) - - if ( model == tracers(n)%model .and. tracers(n)%instances_set ) then !{ We have multiple instances of this tracer - - if ( num_tracer_fields + tracers(n)%instances > MAX_TRACER_FIELDS ) then - write(warnmesg, '("tracer_manager_init: Number of tracers will exceed MAX_TRACER_FIELDS with & - &multiple (",I3," instances) setup of tracer ",A)') tracers(n)%instances,tracers(n)%tracer_name - call mpp_error(FATAL, warnmesg) - endif - - do i = 2, tracers(n)%instances !{ - num_tracer_fields = num_tracer_fields + 1 - total_tracers(model) = total_tracers(model) + 1 - TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields - ! Copy the original tracer type to the multiple instances. - tracers(num_tracer_fields) = tracers(n) - if ( query_method ('instances', model,model_tracer_number(model,n),name, control)) then !{ - - if (i .lt. 10) then !{ - write (suffnam,'(''suffix'',i1)') i - siz_inst = parse(control, suffnam,digit) - if (siz_inst == 0 ) then - write (digit,'(''_'',i1)') i - else - digit = "_"//trim(digit) - endif - elseif (i .lt. 100) then !}{ - write (suffnam,'(''suffix'',i2)') i - siz_inst = parse(control, suffnam,digit) - if (siz_inst == 0 ) then - write (digit,'(''_'',i2)') i - else - digit = "_"//trim(digit) - endif - else !}{ - call mpp_error(FATAL, 'tracer_manager_init: MULTIPLE_TRACER_SET_UP exceeds 100 for '// & - & tracers(n)%tracer_name ) - endif !} - - select case(model) - case (MODEL_COUPLER) - list_name = "/coupler_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_ATMOS) - list_name = "/atmos_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_OCEAN) - list_name = "/ocean_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_ICE ) - list_name = "/ice_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_LAND ) - list_name = "/land_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case default - list_name = "/default/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - end select - - if (mpp_pe() == mpp_root_pe() ) write (*,*) "Creating list name = ",trim(list_name)//trim(digit) - - index_list_name = fm_copy_list(trim(list_name),digit, create = .true.) - tracers(num_tracer_fields)%tracer_name = trim(tracers(num_tracer_fields)%tracer_name)//trim(digit) - endif !} - - if (tracers(num_tracer_fields)%is_prognostic) then !{ - num_prog = num_prog+1 - else !}{ - num_diag = num_diag+1 - endif !} - enddo !} - ! Multiple instances of tracers were found so need to rename the original tracer. - digit = "_1" - siz_inst = parse(control, "suffix1",digit) - if (siz_inst > 0 ) then !{ - digit = "_"//trim(digit) - endif !} - fm_success = fm_modify_name(trim(list_name), trim(tracers(n)%tracer_name)//trim(digit)) - tracers(n)%tracer_name = trim(tracers(n)%tracer_name)//trim(digit) - endif !} -enddo !} - -! Find any field entries with the instances keyword. -do n=1,nfields - call get_field_info(n,type,name,mod,num_methods) - - if ( mod == model .and. type == 'instances' ) then - call get_field_methods(n,methods) - do j=1,num_methods - - if (.not.get_tracer_index(mod,methods(j)%method_type,m)) then - call mpp_error(FATAL,'tracer_manager_init: The instances keyword was found for undefined tracer '& - //trim(methods(j)%method_type)) - else - if ( tracers(m)%instances_set ) & - call mpp_error(FATAL,'tracer_manager_init: The instances keyword was found for '& - //trim(methods(j)%method_type)//' but has previously been defined in the tracer entry') - siz_inst = parse(methods(j)%method_name,"",instances) - tracers(m)%instances = instances - call mpp_error(NOTE,'tracer_manager_init: '//trim(instantiations(j)%name)// & - ' will have '//trim(methods(j)%method_name)//' instances') - endif - if ( num_tracer_fields + instances > MAX_TRACER_FIELDS ) then - write(warnmesg, '("tracer_manager_init: Number of tracers will exceed MAX_TRACER_FIELDS with & - &multiple (",I3," instances) setup of tracer ",A)') tracers(m)%instances,tracers(m)%tracer_name - call mpp_error(FATAL, warnmesg) - endif -! We have found a valid tracer that has more than one instantiation. -! We need to modify that tracer name to tracer_1 and add extra tracers for the extra instantiations. - if (instances .eq. 1) then - siz_inst = parse(methods(j)%method_control, 'suffix1',digit) - if (siz_inst == 0 ) then - digit = '_1' - else - digit = "_"//trim(digit) - endif - endif - do i = 2, instances - num_tracer_fields = num_tracer_fields + 1 - total_tracers(model) = total_tracers(model) + 1 - TRACER_ARRAY(model,total_tracers(model)) = num_tracer_fields - tracers(num_tracer_fields) = tracers(m) - - if (i .lt. 10) then !{ - write (suffnam,'(''suffix'',i1)') i - siz_inst = parse(methods(j)%method_control, suffnam,digit) - if (siz_inst == 0 ) then - write (digit,'(''_'',i1)') i - else - digit = "_"//trim(digit) - endif - elseif (i .lt. 100) then !}{ - write (suffnam,'(''suffix'',i2)') i - siz_inst = parse(methods(j)%method_control, suffnam,digit) - if (siz_inst == 0 ) then - write (digit,'(''_'',i2)') i - else - digit = "_"//trim(digit) - endif - else !}{ - call mpp_error(FATAL, 'tracer_manager_init: MULTIPLE_TRACER_SET_UP exceeds 100 for '& - //tracers(num_tracer_fields)%tracer_name ) - endif !} - - select case(model) - case (MODEL_COUPLER) - list_name = "/coupler_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_ATMOS) - list_name = "/atmos_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_OCEAN) - list_name = "/ocean_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_ICE ) - list_name = "/ice_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case (MODEL_LAND ) - list_name = "/land_mod/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - case default - list_name = "/default/tracer/"//trim(tracers(num_tracer_fields)%tracer_name) - end select - - if (mpp_pe() == mpp_root_pe() ) write (*,*) "Creating list name = ",trim(list_name) - - index_list_name = fm_copy_list(trim(list_name),digit, create = .true.) - tracers(num_tracer_fields)%tracer_name = trim(tracers(num_tracer_fields)%tracer_name)//digit - if (tracers(num_tracer_fields)%is_prognostic) then - num_prog = num_prog+1 - else - num_diag = num_diag+1 - endif - enddo -!Now rename the original tracer to tracer_1 (or if suffix1 present to tracer_'value_of_suffix1') - siz_inst = parse(methods(j)%method_control, 'suffix1',digit) - if (siz_inst == 0 ) then - digit = '_1' - else - digit = "_"//trim(digit) - endif - fm_success = fm_modify_name(trim(list_name), trim(tracers(m)%tracer_name)//trim(digit)) - tracers(m)%tracer_name = trim(tracers(m)%tracer_name)//trim(digit) - enddo - endif -enddo - -num_tracers = num_prog + num_diag -! Make the number of tracers available publicly. -total_tracers(model) = num_tracers -prog_tracers(model) = num_prog -diag_tracers(model) = num_diag -model_registered(model) = .TRUE. - -! Now sort through the tracer fields and sort them so that the -! prognostic tracers are first. - -do n=1, num_tracers - if (.not.check_if_prognostic(model,n) .and. n.le.num_prog) then - ! This is a diagnostic tracer so find a prognostic tracer to swop with - do m = n, num_tracers - if (check_if_prognostic(model,m) .and. .not.check_if_prognostic(model,n)) then - swop = TRACER_ARRAY(model,n) - TRACER_ARRAY(model,n) = TRACER_ARRAY(model,m) - TRACER_ARRAY(model,m) = swop - cycle - endif - enddo - endif -enddo - -do n=1, num_tracer_fields - call print_tracer_info(model,n) -enddo - -log_unit = stdlog() -if ( mpp_pe() == mpp_root_pe() ) then - write (log_unit,15) trim(MODEL_NAMES(model)),total_tracers(model) -endif - -15 format ('Number of tracers in field table for ',A,' model = ',i4) - -end subroutine get_tracer_meta_data - -function model_tracer_number(model,n) -integer, intent(in) :: model, n -integer model_tracer_number - -integer :: i - -model_tracer_number = NO_TRACER - -do i = 1, MAX_TRACER_FIELDS - if ( TRACER_ARRAY(model,i) == n ) then - model_tracer_number = i - return - endif -enddo - -end function model_tracer_number - -!####################################################################### - -!> @brief Not necessary to call, only needed for backward compatability. -!! -!> Returns the total number of valid, prognostic and diagnostic tracers. -subroutine register_tracers(model, num_tracers, num_prog, num_diag, num_family) -integer, intent(in) :: model !< A parameter to identify which model is being used. -integer, intent(out) :: num_tracers !< The total number of valid tracers within the component model. -integer, intent(out) :: num_prog !< The number of prognostic tracers within the component model. -integer, intent(out) :: num_diag !< The number of diagnostic tracers within the component model. -integer, intent(out), optional :: num_family - -if(.not.module_is_initialized) call tracer_manager_init - -call get_number_tracers(model, num_tracers, num_prog, num_diag, num_family) - -end subroutine register_tracers - -!####################################################################### - -!> @brief A routine to return the number of tracers included in a component model. -!! -!> This routine returns the total number of valid tracers, -!! the number of prognostic and diagnostic tracers -subroutine get_number_tracers(model, num_tracers, num_prog, num_diag, num_family) - -integer, intent(in) :: model !< A parameter to identify which model is being used -integer, intent(out), optional :: num_tracers !< The total number of valid tracers within - !! the component model -integer, intent(out), optional :: num_prog !< The number of prognostic tracers within the - !! component model. -integer, intent(out), optional :: num_diag !< The number of diagnostic tracers within the - !! component model -integer, intent(out), optional :: num_family - -if(.not.module_is_initialized) call tracer_manager_init - -! -! The index of the component model is invalid. -! -if (model .ne. MODEL_ATMOS .and. model .ne. MODEL_LAND .and. & - model .ne. MODEL_OCEAN .and. model .ne. MODEL_ICE .and. & - model .ne. MODEL_COUPLER) & - call mpp_error(FATAL,"get_number_tracers : Model number is invalid.") - -if (present(num_tracers)) num_tracers = total_tracers(model) -if (present(num_prog)) num_prog = prog_tracers(model) -if (present(num_diag)) num_diag = diag_tracers(model) -if (present(num_family)) num_family = 0 ! Needed only for backward compatability with lima - -end subroutine get_number_tracers - -!> @brief Routine to return the component model tracer indices as defined within -!! the tracer manager. -!! -!> If several models are being used or redundant tracers have been written to -!! the tracer_table, then the indices in the component model and the tracer -!! manager may not have a one to one correspondence. Therefore the component -!! model needs to know what index to pass to calls to tracer_manager routines in -!! order that the correct tracer information be accessed. -!> @param model A parameter to identify which model is being used. -!> @param ind An array containing the tracer manager defined indices for -!! all the tracers within the component model. -!> @param prog_ind An array containing the tracer manager defined indices for -!! the prognostic tracers within the component model. -!> @param diag_ind An array containing the tracer manager defined indices for -!! the diagnostic tracers within the component model. -subroutine get_tracer_indices(model, ind, prog_ind, diag_ind, fam_ind) - -integer, intent(in) :: model -integer, intent(out), dimension(:), optional :: ind, prog_ind, diag_ind, fam_ind - -integer :: i, j, np, nd, n - -if(.not.module_is_initialized) call tracer_manager_init - -nd=0;np=0;n=0 - -! Initialize arrays with dummy values -if (PRESENT(ind)) ind = NO_TRACER -if (PRESENT(prog_ind)) prog_ind = NO_TRACER -if (PRESENT(diag_ind)) diag_ind = NO_TRACER -if (PRESENT(fam_ind)) fam_ind = NO_TRACER - -do i = 1, MAX_TRACER_FIELDS -j = TRACER_ARRAY(model,i) - if ( j /= NOTRACER) then - if ( model == tracers(j)%model) then - if (PRESENT(ind)) then - n=n+1 -! -! The global index array is too small and cannot contain all the tracer numbers. -! - if (n > size(ind(:))) call mpp_error(FATAL, & - & 'get_tracer_indices : index array size too small in get_tracer_indices') - ind(n) = i - endif - - if (tracers(j)%is_prognostic.and.PRESENT(prog_ind)) then - np=np+1 -! -! The prognostic index array is too small and cannot contain all the tracer numbers. -! - if ( np > size( prog_ind(:)))call mpp_error(FATAL,& - 'get_tracer_indices : prognostic array size too small in get_tracer_indices') - prog_ind(np) = i - else if (.not.tracers(j)%is_prognostic .and. PRESENT(diag_ind)) then - nd = nd+1 -! -! The diagnostic index array is too small and cannot contain all the tracer numbers. -! - if (nd > size(diag_ind(:))) call mpp_error(FATAL,& - 'get_tracer_indices : diagnostic array size too small in get_tracer_indices') - diag_ind(nd) = i - endif - endif - endif -enddo - -return -end subroutine get_tracer_indices - -! -! -! Function which returns the number assigned to the tracer name. -! -! -! This is a function which returns the index, as implied within the component model. -! There are two overloaded interfaces: one of type integer, one logical. -! -! -! -! A parameter to identify which model is being used. -! -! -! The name of the tracer (as assigned in the field table). -! -! -! An array indices. -! When present, the returned index will limit the search for the tracer -! to those tracers whos indices are amoung those in array "indices". -! This would be useful when it is desired to limit the search to a subset -! of the tracers. Such a subset might be the diagnostic or prognostic tracers. -! (Note that subroutine get_tracer_indices returns these subsets) -! -! -! A flag to allow the message saying that a tracer with this name has not -! been found. This should only be used for debugging purposes. -! -! -! integer function: -! The index of the tracer named "name". -! If no tracer by that name exists then the returned value is NO_TRACER. -! logical function: -! If no tracer by that name exists then the returned value is .false., -! otherwise the returned value is .true. -! - -!> @brief Function which returns the number assigned to the tracer name. -!! -!> See @ref get_tracer_index Interface for more information. -!! @returns index of given tracer name if present, otherwise returns NO_TRACER -function get_tracer_index_integer(model, name, indices, verbose) - -integer, intent(in) :: model !< Parameter to identify which model is used -character(len=*), intent(in) :: name !< name of the tracer -integer, intent(in), dimension(:), optional :: indices !< An array of indices, limits search to tracers - !! whose indices are within the array. -logical, intent(in), optional :: verbose !< debug flag -integer :: get_tracer_index_integer - -integer :: i - -if(.not.module_is_initialized) call tracer_manager_init - -get_tracer_index_integer = NO_TRACER - -if (PRESENT(indices)) then - do i = 1, size(indices(:)) - if (model == tracers(indices(i))%model .and. lowercase(trim(name)) == trim(tracers(indices(i))%tracer_name))then - get_tracer_index_integer = i - exit - endif - enddo -else - do i=1, num_tracer_fields - if(TRACER_ARRAY(model,i) == NOTRACER) cycle - if (lowercase(trim(name)) == trim(tracers(TRACER_ARRAY(model,i))%tracer_name)) then - get_tracer_index_integer = i!TRACER_ARRAY(model,i) - exit - endif - enddo -end if - -verbose_local=.FALSE. -if (present(verbose)) verbose_local=verbose - -if (verbose_local) then -! - if (get_tracer_index_integer == NO_TRACER ) then - call mpp_error(NOTE,'get_tracer_index : tracer with this name not found: '//trim(name)) - endif -! -endif - -return - -end function get_tracer_index_integer - -!####################################################################### -!> @brief Checks if tracer is present, and returns it's position in index -function get_tracer_index_logical(model, name, index, indices, verbose) - -integer, intent(in) :: model !< Parameter for which model is used -character(len=*), intent(in) :: name !< name of given drifter -integer, intent(out) :: index !< returned drifter index -integer, intent(in), dimension(:), optional :: indices !< optional list of indices to limit results to -logical, intent(in), optional :: verbose !< debug flag -logical :: get_tracer_index_logical - -index = get_tracer_index_integer(model, name, indices, verbose) -if(index == NO_TRACER) then - get_tracer_index_logical = .false. -else - get_tracer_index_logical = .true. -endif - -end function get_tracer_index_logical - -!####################################################################### - -!> @brief Uninitializes module and writes exit to logfile. -subroutine tracer_manager_end - -integer :: log_unit - -log_unit = stdlog() -if ( mpp_pe() == mpp_root_pe() ) then - write (log_unit,'(/,(a))') 'Exiting tracer_manager, have a nice day ...' -endif - -module_is_initialized = .FALSE. - -end subroutine tracer_manager_end - -!####################################################################### - -!> @brief Routine to print out the components of the tracer. -!! This is useful for informational purposes. -!! Used in get_tracer_meta_data. -subroutine print_tracer_info(model,n) -integer, intent(in) :: model -integer, intent(in) :: n !< index of the tracer that is being printed -integer :: i, log_unit - -if(.not.module_is_initialized) call tracer_manager_init - -if(mpp_pe()==mpp_root_pe() .and. TRACER_ARRAY(model,n)> 0 ) then - i = TRACER_ARRAY(model,n) - log_unit = stdlog() - write(log_unit, *)'----------------------------------------------------' - write(log_unit, *) 'Contents of tracer entry ', i - write(log_unit, *) 'Model type and field name' - write(log_unit, *) 'Model : ', tracers(i)%model - write(log_unit, *) 'Field name : ', trim(tracers(i)%tracer_name) - write(log_unit, *) 'Tracer units : ', trim(tracers(i)%tracer_units) - write(log_unit, *) 'Tracer longname : ', trim(tracers(i)%tracer_longname) - write(log_unit, *) 'Tracer is_prognostic : ', tracers(i)%is_prognostic - write(log_unit, *)'----------------------------------------------------' -endif - -end subroutine print_tracer_info - -!####################################################################### - -!> @brief Routine to find the names associated with a tracer number. -!! -!> This routine can return the name, long name and units associated -!! with a tracer. -subroutine get_tracer_names(model,n,name,longname, units, err_msg) - -integer, intent(in) :: model !< A parameter representing component model in use -integer, intent(in) :: n !< Tracer number -character (len=*),intent(out) :: name !< Field name associate with tracer number -character (len=*), intent(out), optional :: longname !< Long name associated with tracer number -character (len=*), intent(out), optional :: units !< Tracer associated units -character (len=*), intent(out), optional :: err_msg -character (len=128) :: err_msg_local -integer :: n1 -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - - if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - if(error_handler('get_tracer_names', err_msg_local, err_msg)) return - endif - n1 = TRACER_ARRAY(model,n) - -name = trim(tracers(n1)%tracer_name) -if (PRESENT(longname)) longname = trim(tracers(n1)%tracer_longname) -if (PRESENT(units)) units = trim(tracers(n1)%tracer_units) - -end subroutine get_tracer_names - -!####################################################################### - -!> @brief Routine to find the names associated with a tracer number. -!! -!> This routine can return the name, long name and units associated with a tracer. -!! The return value of get_tracer_name is .false. when a FATAL error condition is -!! detected, otherwise the return value is .true. -function get_tracer_name(model,n,name,longname, units, err_msg) - -integer, intent(in) :: model !< A parameter representing component model in use -integer, intent(in) :: n !< Tracer number -character (len=*),intent(out) :: name !< Field name associate with tracer number -character (len=*), intent(out), optional :: longname !< Long name associated with tracer number -character (len=*), intent(out), optional :: units !< Tracer associated units -character (len=*), intent(out), optional :: err_msg !< When present: If a FATAL error condition is - !! detected then err_msg will contain an error message - !! and the return value of get_tracer_name will be .false. - !! If no FATAL error is detected err_msg will be filled with space characters and - !! and the return value of get_tracer_name will be .true. - !! When not present: - !! A FATAL error will result in termination inside get_tracer_name without returning. - !! If no FATAL error is detected the return value of get_tracer_name will be .true. - -logical :: get_tracer_name -character (len=128) :: err_msg_local -integer :: n1 -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - - if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - if(error_handler('get_tracer_name', err_msg_local, err_msg)) then - get_tracer_name = .false. - return - endif - else - get_tracer_name = .true. - endif - n1 = TRACER_ARRAY(model,n) - -name = trim(tracers(n1)%tracer_name) -if (PRESENT(longname)) longname = trim(tracers(n1)%tracer_longname) -if (PRESENT(units)) units = trim(tracers(n1)%tracer_units) - -end function get_tracer_name - -!####################################################################### - -!> @brief Function to see if a tracer is prognostic or diagnostic. -!! -!> All tracers are assumed to be prognostic when read in from the field_table -!! However a tracer can be changed to a diagnostic tracer by adding the line -!! "tracer_type","diagnostic" -!! to the tracer description in field_table. -!! -!! @returns A logical flag set TRUE if the tracer is prognostic. -function check_if_prognostic(model, n, err_msg) - -integer, intent(in) :: model !< Parameter representing component model in use -integer, intent(in) :: n !< Tracer number -logical :: check_if_prognostic -character(len=*), intent(out), optional :: err_msg -character(len=128) :: err_msg_local -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - -if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - check_if_prognostic = .true. - if(error_handler('check_if_prognostic', err_msg_local, err_msg)) return -endif - -!Convert local model index to tracer_manager index - -check_if_prognostic = tracers(TRACER_ARRAY(model,n))%is_prognostic - -end function check_if_prognostic - -! Does tracer need mass or positive definite adjustments? -!####################################################################### -!> Function to check whether tracer should have its mass adjusted -function adjust_mass(model, n, err_msg) - -integer, intent(in) :: model, n -logical :: adjust_mass -character(len=*), intent(out), optional :: err_msg -character(len=128) :: err_msg_local -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - -if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - adjust_mass = .true. - if(error_handler('adjust_mass', err_msg_local, err_msg)) return -endif - -!Convert local model index to tracer_manager index - -adjust_mass = tracers(TRACER_ARRAY(model,n))%needs_mass_adjust - -end function adjust_mass - -! Function to check whether tracer should be adjusted to remain positive definite -function adjust_positive_def(model, n, err_msg) - -integer, intent(in) :: model, n -logical :: adjust_positive_def -character(len=*), intent(out), optional :: err_msg -character(len=128) :: err_msg_local -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - -if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - adjust_positive_def = .true. - if(error_handler('adjust_positive_def', err_msg_local, err_msg)) return -endif - -!Convert local model index to tracer_manager index - -adjust_positive_def = tracers(TRACER_ARRAY(model,n))%needs_positive_adjust - -end function adjust_positive_def - -!####################################################################### !> @brief Subroutine to set the tracer field to the wanted profile. !! @@ -1030,19 +44,21 @@ end function adjust_positive_def !! !! If you wish to initialize the ocean model, one can use bottom_value instead !! of top_value. -subroutine set_tracer_profile(model, n, tracer, err_msg) +subroutine SET_TRACER_PROFILE_(model, n, tracer, err_msg) integer, intent(in) :: model !< Parameter representing component model in use integer, intent(in) :: n !< Tracer number -real, intent(inout), dimension(:,:,:) :: tracer !< Initialized tracer array +real(FMS_TM_KIND_), intent(inout), dimension(:,:,:) :: tracer !< Initialized tracer array character(len=*), intent(out), optional :: err_msg -real :: surf_value, multiplier +real(FMS_TM_KIND_) :: surf_value, multiplier integer :: numlevels, k, n1, flag -real :: top_value, bottom_value -character(len=80) :: scheme, control,profile_type +real(FMS_TM_KIND_) :: top_value, bottom_value +character(len=80) :: scheme, control,profile_type character(len=128) :: err_msg_local -character(len=11) :: chn +character(len=11) :: chn + +integer, parameter :: lkind=FMS_TM_KIND_ if(.not.module_is_initialized) call tracer_manager_init @@ -1055,10 +71,10 @@ n1 = TRACER_ARRAY(model,n) !default values profile_type = 'Fixed' -surf_value = 0.0E+00 +surf_value = 0.0E+00_lkind top_value = surf_value bottom_value = surf_value -multiplier = 1.0 +multiplier = 1.0_lkind tracer = surf_value @@ -1068,14 +84,14 @@ if ( query_method ( 'profile_type',model,n,scheme,control)) then if(lowercase(trim(scheme(1:5))).eq.'fixed') then profile_type = 'Fixed' flag =parse(control,'surface_value',surf_value) - multiplier = 1.0 + multiplier = 1.0_lkind tracer = surf_value endif if(lowercase(trim(scheme(1:7))).eq.'profile') then profile_type = 'Profile' flag=parse(control,'surface_value',surf_value) - if (surf_value .eq. 0.0) & + if (surf_value .eq. 0.0_lkind) & call mpp_error(FATAL,'set_tracer_profile : Cannot have a zero surface value for an exponential profile. Tracer '& //tracers(n1)%tracer_name//" "//control//" "//scheme) select case (tracers(n1)%model) @@ -1102,13 +118,13 @@ if ( query_method ( 'profile_type',model,n,scheme,control)) then numlevels = size(tracer,3) -1 select case (tracers(n1)%model) case (MODEL_ATMOS) - multiplier = exp( log (top_value/surf_value) /numlevels) + multiplier = exp( log (top_value/surf_value) /real(numlevels,lkind)) tracer(:,:,1) = surf_value do k = 2, size(tracer,3) tracer(:,:,k) = tracer(:,:,k-1) * multiplier enddo case (MODEL_OCEAN) - multiplier = exp( log (bottom_value/surf_value) /numlevels) + multiplier = exp( log (bottom_value/surf_value) / real(numlevels,lkind)) tracer(:,:,size(tracer,3)) = surf_value do k = size(tracer,3) - 1, 1, -1 tracer(:,:,k) = tracer(:,:,k+1) * multiplier @@ -1124,215 +140,8 @@ numlevels = size(tracer,3) -1 endif ! end of query scheme -end subroutine set_tracer_profile +end subroutine SET_TRACER_PROFILE_ !####################################################################### - -!> @brief A function to query the schemes associated with each tracer. -!! -!> A function to query the "methods" associated with each tracer. The -!! "methods" are the parameters of the component model that can be -!! adjusted by user by placing formatted strings, associated with a -!! particular tracer, within the field table. -!! These methods can control the advection, wet deposition, dry -!! deposition or initial profile of the tracer in question. Any -!! parametrization can use this function as long as a routine for parsing -!! -!! @returns A flag to show whether method_type exists with regard to tracer n. If method_type is not -!! present then one must have default values. the name and control strings are provided by that routine. -!! -!! @note At present the tracer manager module allows the initialization of a tracer -!! profile if a restart does not exist for that tracer. -!! Options for this routine are as follows -!! -!! Tracer profile setup -!! ================================================================== -!! |method_type |method_name |method_control | -!! ================================================================== -!! |profile_type |fixed |surface_value = X | -!! |profile_type |profile |surface_value = X, top_value = Y |(atmosphere) -!! |profile_type |profile |surface_value = X, bottom_value = Y |(ocean) -!! ================================================================== - function query_method (method_type, model, n, name, control, err_msg) - - character(len=*), intent(in) :: method_type !< The requested method - integer , intent(in) :: model !< Model the function is being called from - integer , intent(in) :: n !< Tracer number - character(len=*), intent(out) :: name !< A string containing the modified name to be used - !! with method_type. i.e. "2nd_order" might be the default - !! advection. One could use "4th_order" to modify behaviour - character(len=*), intent(out), optional :: control !< A string containing the modified parameters - !! that are associated with method_type and name. - character(len=*), intent(out), optional :: err_msg - logical :: query_method - - integer :: n1 - character(len=256) :: list_name - character(len=1024):: control_tr - character(len=16) :: chn,chn1 - character(len=128) :: err_msg_local - - if(.not.module_is_initialized) call tracer_manager_init - -!Convert the local model tracer number to the tracer_manager version. - - if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - if(error_handler('query_method', err_msg_local, err_msg)) return - endif - - n1 = TRACER_ARRAY(model,n) - - select case(model) - case (MODEL_COUPLER) - list_name = "/coupler_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - case (MODEL_ATMOS) - list_name = "/atmos_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - case (MODEL_OCEAN) - list_name = "/ocean_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - case (MODEL_ICE ) - list_name = "/ice_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - case (MODEL_LAND ) - list_name = "/land_mod/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - case default - list_name = "/default/tracer/"//trim(tracers(n1)%tracer_name)//"/"//trim(method_type) - end select - - name = '' - control_tr = '' - query_method = fm_query_method(list_name, name, control_tr) - - if ( present(control) ) then - if ( len_trim(control_tr)>len(control) ) then - write(chn,*)len(control) - write(chn1,*)len_trim(control_tr) - if(error_handler('query_method', & - ' Output string length ('//trim(adjustl(chn)) & - // ') is not enough to return all "control" parameters ("'//trim(control_tr) & - // '", length='//trim(adjustl(chn1))//')', & - err_msg)) return - endif - control = trim(control_tr) - endif - - end function query_method - -!> @brief A subroutine to allow the user set the tracer longname and units from the -!! tracer initialization routine. -!! -!> A function to allow the user set the tracer longname and units from the -!! tracer initialization routine. It seems sensible that the user who is -!! coding the tracer code will know what units they are working in and it -!! is probably safer to set the value in the tracer code rather than in -!! the field table. -subroutine set_tracer_atts(model, name, longname, units) - -integer, intent(in) :: model !< A parameter representing component model in use -character(len=*), intent(in) :: name !< Tracer name -character(len=*), intent(in), optional :: longname !< Long name of the tracer -character(len=*), intent(in), optional :: units !< Units for the tracer - -integer :: n, index -logical :: success -character(len=128) :: list_name - -if ( get_tracer_index(model,name,n) ) then - tracers(TRACER_ARRAY(model,n))%tracer_units = units - tracers(TRACER_ARRAY(model,n))%tracer_longname = longname - select case(model) - case(MODEL_COUPLER) - list_name = "/coupler_mod/tracer/"//trim(name) - case(MODEL_ATMOS) - list_name = "/atmos_mod/tracer/"//trim(name) - case(MODEL_OCEAN) - list_name = "/ocean_mod/tracer/"//trim(name) - case(MODEL_LAND) - list_name = "/land_mod/tracer/"//trim(name) - case(MODEL_ICE) - list_name = "/ice_mod/tracer/"//trim(name) - case DEFAULT - list_name = "/"//trim(name) - end select - -! Method_type is a list, method_name is a name of a parameter and method_control has the value. -! list_name = trim(list_name)//"/longname" - if ( fm_exists(list_name)) then - success = fm_change_list(list_name) - if ( present(longname) ) then - if ( longname .ne. "" ) index = fm_new_value('longname',longname) - endif - if ( present(units) ) then - if (units .ne. "" ) index = fm_new_value('units',units) - endif - endif - -else - call mpp_error(NOTE,'set_tracer_atts : Trying to set longname and/or units for non-existent tracer : '//trim(name)) -endif - -end subroutine set_tracer_atts - -!> @brief A subroutine to allow the user to set some tracer specific methods. -subroutine set_tracer_method(model, name, method_type, method_name, method_control) - -integer, intent(in) :: model !< A parameter representing component model in use -character(len=*), intent(in) :: name !< Tracer name -character(len=*), intent(in) :: method_type !< type of method to be set -character(len=*), intent(in) :: method_name !< name of method to be set -character(len=*), intent(in) :: method_control !< control parameters of the given method - -integer :: n, num_method, index -logical :: success -character(len=128) :: list_name - -if ( get_tracer_index(model,name,n) ) then - tracers(n)%num_methods = tracers(n)%num_methods + 1 - num_method = tracers(n)%num_methods - - select case(model) - case(MODEL_COUPLER) - list_name = "/coupler_mod/tracer/"//trim(name) - case(MODEL_ATMOS) - list_name = "/atmos_mod/tracer/"//trim(name) - case(MODEL_OCEAN) - list_name = "/ocean_mod/tracer/"//trim(name) - case(MODEL_LAND) - list_name = "/land_mod/tracer/"//trim(name) - case(MODEL_ICE) - list_name = "/ice_mod/tracer/"//trim(name) - case DEFAULT - list_name = "/"//trim(name) - end select - - if ( method_control .ne. "" ) then -! Method_type is a list, method_name is a name of a parameter and method_control has the value. - list_name = trim(list_name)//"/"//trim(method_type) - if ( fm_exists(list_name)) then - success = fm_change_list(list_name) - index = fm_new_value(method_type,method_control) - endif - else - call mpp_error(NOTE,'set_tracer_method : Trying to set a method for non-existent tracer : '//trim(name)) - endif -endif - -end subroutine set_tracer_method - -function error_handler(routine, err_msg_local, err_msg) -logical :: error_handler -character(len=*), intent(in) :: routine, err_msg_local -character(len=*), intent(out), optional :: err_msg - -if(present(err_msg)) then - err_msg = err_msg_local - error_handler = .true. -else - call mpp_error(FATAL,trim(routine)//': '//trim(err_msg_local)) -endif - -end function error_handler - -end module tracer_manager_mod !> @} ! close documentation grouping diff --git a/tracer_manager/include/tracer_manager_r4.fh b/tracer_manager/include/tracer_manager_r4.fh new file mode 100644 index 0000000000..7b3a0513c9 --- /dev/null +++ b/tracer_manager/include/tracer_manager_r4.fh @@ -0,0 +1,28 @@ +!*********************************************************************** +!* 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 tracer_manager_mod tracer_manager_mod +!> @ingroup tracer_manager + +#undef FMS_TM_KIND_ +#define FMS_TM_KIND_ r4_kind + +#undef SET_TRACER_PROFILE_ +#define SET_TRACER_PROFILE_ set_tracer_profile_r4 + +#include "tracer_manager.inc" diff --git a/tracer_manager/include/tracer_manager_r8.fh b/tracer_manager/include/tracer_manager_r8.fh new file mode 100644 index 0000000000..d330e82734 --- /dev/null +++ b/tracer_manager/include/tracer_manager_r8.fh @@ -0,0 +1,28 @@ +!*********************************************************************** +!* 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 tracer_manager_mod tracer_manager_mod +!> @ingroup tracer_manager + +#undef FMS_TM_KIND_ +#define FMS_TM_KIND_ r8_kind + +#undef SET_TRACER_PROFILE_ +#define SET_TRACER_PROFILE_ set_tracer_profile_r8 + +#include "tracer_manager.inc" diff --git a/tracer_manager/tracer_manager.F90 b/tracer_manager/tracer_manager.F90 index 5c2321fce4..70375b5ab1 100644 --- a/tracer_manager/tracer_manager.F90 +++ b/tracer_manager/tracer_manager.F90 @@ -72,6 +72,8 @@ module tracer_manager_mod fm_new_value, & fm_exists, & MODEL_NAMES +use platform_mod, only : r4_kind, & + r8_kind implicit none private @@ -125,6 +127,11 @@ module tracer_manager_mod module procedure get_tracer_index_integer, get_tracer_index_logical end interface +interface set_tracer_profile + module procedure set_tracer_profile_r4 + module procedure set_tracer_profile_r8 +end interface set_tracer_profile + !> Private type to hold metadata for a tracer !> @ingroup tracer_manager_mod type, private :: tracer_type @@ -1006,128 +1013,6 @@ end function adjust_positive_def !####################################################################### -!> @brief Subroutine to set the tracer field to the wanted profile. -!! -!> If the profile type is 'fixed' then the tracer field values are set -!! equal to the surface value. -!! If the profile type is 'profile' then the top/bottom of model and -!! surface values are read and an exponential profile is calculated, -!! with the profile being dependent on the number of levels in the -!! component model. This should be called from the part of the dynamical -!! core where tracer restarts are called in the event that a tracer -!! restart file does not exist. -!! -!! This can be activated by adding a method to the field_table -!! e.g. -!! @verbose "profile_type","fixed","surface_value = 1e-12" @endverbose -!! would return values of surf_value = 1e-12 and a multiplier of 1.0 -!! One can use these to initialize the entire field with a value of 1e-12. -!! -!! "profile_type","profile","surface_value = 1e-12, top_value = 1e-15" -!! In a 15 layer model this would return values of surf_value = 1e-12 and -!! multiplier = 0.6309573 i.e 1e-15 = 1e-12*(0.6309573^15) -!! In this case the model should be MODEL_ATMOS as you have a "top" value. -!! -!! If you wish to initialize the ocean model, one can use bottom_value instead -!! of top_value. -subroutine set_tracer_profile(model, n, tracer, err_msg) - -integer, intent(in) :: model !< Parameter representing component model in use -integer, intent(in) :: n !< Tracer number -real, intent(inout), dimension(:,:,:) :: tracer !< Initialized tracer array -character(len=*), intent(out), optional :: err_msg - -real :: surf_value, multiplier -integer :: numlevels, k, n1, flag -real :: top_value, bottom_value -character(len=80) :: scheme, control,profile_type -character(len=128) :: err_msg_local -character(len=11) :: chn - -if(.not.module_is_initialized) call tracer_manager_init - -if (n < 1 .or. n > total_tracers(model)) then - write(chn, '(i11)') n - err_msg_local = ' Invalid tracer index. Model name = '//trim(MODEL_NAMES(model))//', Index='//trim(chn) - if(error_handler('set_tracer_profile', err_msg_local, err_msg)) return -endif -n1 = TRACER_ARRAY(model,n) - -!default values -profile_type = 'Fixed' -surf_value = 0.0E+00 -top_value = surf_value -bottom_value = surf_value -multiplier = 1.0 - -tracer = surf_value - -if ( query_method ( 'profile_type',model,n,scheme,control)) then -!Change the tracer_number to the tracer_manager version - - if(lowercase(trim(scheme(1:5))).eq.'fixed') then - profile_type = 'Fixed' - flag =parse(control,'surface_value',surf_value) - multiplier = 1.0 - tracer = surf_value - endif - - if(lowercase(trim(scheme(1:7))).eq.'profile') then - profile_type = 'Profile' - flag=parse(control,'surface_value',surf_value) - if (surf_value .eq. 0.0) & - call mpp_error(FATAL,'set_tracer_profile : Cannot have a zero surface value for an exponential profile. Tracer '& - //tracers(n1)%tracer_name//" "//control//" "//scheme) - select case (tracers(n1)%model) - case (MODEL_ATMOS) - flag=parse(control,'top_value',top_value) - if(mpp_pe()==mpp_root_pe() .and. flag == 0) & - call mpp_error(NOTE,'set_tracer_profile : Parameter top_value needs to be defined for the tracer profile.') - case (MODEL_OCEAN) - flag =parse(control,'bottom_value',bottom_value) - if(mpp_pe() == mpp_root_pe() .and. flag == 0) & - call mpp_error(NOTE, & - & 'set_tracer_profile : Parameter bottom_value needs to be defined for the tracer profile.') - case default -! Should there be a NOTE or WARNING message here? - end select - -! If profile type is profile then set the surface value to the input -! value and calculate the vertical multiplier. -! -! Assume an exponential decay/increase from the surface to the top level -! C = C0 exp ( -multiplier* level_number) -! => multiplier = exp [ ln(Ctop/Csurf)/number_of_levels] -! -numlevels = size(tracer,3) -1 - select case (tracers(n1)%model) - case (MODEL_ATMOS) - multiplier = exp( log (top_value/surf_value) /numlevels) - tracer(:,:,1) = surf_value - do k = 2, size(tracer,3) - tracer(:,:,k) = tracer(:,:,k-1) * multiplier - enddo - case (MODEL_OCEAN) - multiplier = exp( log (bottom_value/surf_value) /numlevels) - tracer(:,:,size(tracer,3)) = surf_value - do k = size(tracer,3) - 1, 1, -1 - tracer(:,:,k) = tracer(:,:,k+1) * multiplier - enddo - case default - end select - endif !scheme.eq.profile - - if (mpp_pe() == mpp_root_pe() ) write(*,700) 'Tracer ',trim(tracers(n1)%tracer_name), & - ' initialized with surface value of ',surf_value, & - ' and vertical multiplier of ',multiplier - 700 FORMAT (3A,E13.6,A,F13.6) - -endif ! end of query scheme - -end subroutine set_tracer_profile - -!####################################################################### - !> @brief A function to query the schemes associated with each tracer. !! !> A function to query the "methods" associated with each tracer. The @@ -1333,6 +1218,9 @@ function error_handler(routine, err_msg_local, err_msg) end function error_handler +#include "tracer_manager_r4.fh" +#include "tracer_manager_r8.fh" + end module tracer_manager_mod !> @} ! close documentation grouping