Merged mlres tracer from user/mc/bling13

- Taken from internal repository at commit ed2f242

Author: Mariona Claret

generic_tracers/generic_mlres.F90

@@ -0,0 +1,395 @@
+!----------------------------------------------------------------
+! <CONTACT EMAIL="[email protected]"> Niki Zadeh 
+! </CONTACT>
+! 
+! <REVIEWER EMAIL="[email protected]"> William Cooke
+! </REVIEWER>
+!<OVERVIEW>
+!</OVERVIEW>
+!
+!<DESCRIPTION>
+!       Implementation of routines to solve the amount of time that a water parcel 
+!       at any give location has last resided in the mixed layer
+!</DESCRIPTION>
+!
+! </DEVELOPER_NOTES>
+! </INFO>
+!
+!----------------------------------------------------------------
+
+module generic_mlres
+
+  use coupler_types_mod, only: coupler_2d_bc_type
+  use field_manager_mod, only: fm_string_len
+  !use mpp_mod, only : mpp_error, NOTE, WARNING, FATAL, stdout
+  use mpp_mod,           only: input_nml_file, mpp_error, stdlog, NOTE, WARNING, FATAL, stdout, mpp_chksum
+  use fms_mod,           only: write_version_number, open_namelist_file, check_nml_error, close_file
+  use time_manager_mod, only : time_type
+  use fm_util_mod,       only: fm_util_start_namelist, fm_util_end_namelist  
+
+  use g_tracer_utils, only : g_tracer_type,g_tracer_start_param_list,g_tracer_end_param_list
+  use g_tracer_utils, only : g_tracer_add,g_tracer_add_param, g_tracer_set_files
+  use g_tracer_utils, only : g_tracer_set_values,g_tracer_get_pointer,g_tracer_get_common
+  use g_tracer_utils, only : g_tracer_coupler_set,g_tracer_coupler_get
+  use g_tracer_utils, only : g_tracer_send_diag, g_tracer_get_values  
+
+
+  implicit none ; private
+
+  character(len=fm_string_len), parameter :: mod_name       = 'generic_mlres'
+  character(len=fm_string_len), parameter :: package_name   = 'generic_mlres'
+
+  public do_generic_mlres
+  public generic_mlres_register
+  public generic_mlres_init
+  public generic_mlres_update_from_coupler
+  public generic_mlres_update_from_source
+  public generic_mlres_set_boundary_values
+  public generic_mlres_end
+
+  !The following logical for using this module is overwritten 
+  ! by generic_tracer_nml namelist
+  logical, save :: do_generic_mlres = .false.
+
+  real, parameter :: epsln=1.0e-30
+
+  real :: reset_time=1.0
+
+  namelist /generic_mlres_nml/ reset_time
+  !
+  !This type contains all the parameters and arrays used in this module.
+  !
+  !Note that there is no programatic reason for treating
+  !the following as a type. These are the parameters used only in this module. 
+  !It suffices for varables to be a declared at the top of the module. 
+  !nnz: Find out about the timing overhead for using type%x rather than x
+
+  type generic_mlres_params
+      real :: Rho_0
+     character(len=fm_string_len) :: ice_restart_file
+     character(len=fm_string_len) :: ocean_restart_file,IC_file
+  end type generic_mlres_params
+
+
+  type(generic_mlres_params) :: param
+
+contains
+
+  subroutine generic_mlres_register(tracer_list)
+    type(g_tracer_type), pointer :: tracer_list
+
+integer                                                 :: ioun
+integer                                                 :: ierr
+integer                                                 :: io_status
+character(len=fm_string_len)                            :: name
+integer                                                 :: stdoutunit,stdlogunit
+
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_register'
+
+! provide for namelist over-ride
+! This needs to go before the add_tracers in order to allow the namelist 
+! settings to switch tracers on and off.
+!
+stdoutunit=stdout();stdlogunit=stdlog()
+
+#ifdef INTERNAL_FILE_NML
+read (input_nml_file, nml=generic_mlres_nml, iostat=io_status)
+ierr = check_nml_error(io_status,'generic_mlres_nml')
+#else
+ioun = open_namelist_file()
+read  (ioun, generic_bling_nml,iostat=io_status)
+ierr = check_nml_error(io_status,'generic_mlres_nml')
+call close_file (ioun)
+#endif
+
+write (stdoutunit,'(/)')
+write (stdoutunit, generic_mlres_nml)
+write (stdlogunit, generic_mlres_nml)
+
+    !Specify all prognostic and diagnostic tracers of this modules.
+    call user_add_tracers(tracer_list)
+    
+    
+  end subroutine generic_mlres_register
+
+  ! <SUBROUTINE NAME="generic_mlres_init">
+  !  <OVERVIEW>
+  !   Initialize the generic mixed layer residence tracer
+  !  </OVERVIEW>
+  !  <DESCRIPTION>
+  !   This subroutine: 
+  !       Adds all the residence tracers to the list of generic Tracers passed to it via utility subroutine g_tracer_add().
+  !       Adds all the parameters used by this module via utility subroutine g_tracer_add_param().
+  !       Allocates all work arrays used in the module. 
+  !  </DESCRIPTION>
+  !  <TEMPLATE>
+  !   call generic_mlres_init(tracer_list)
+  !  </TEMPLATE>
+  !  <IN NAME="tracer_list" TYPE="type(g_tracer_type), pointer">
+  !   Pointer to the head of generic tracer list.
+  !  </IN>
+  ! </SUBROUTINE>
+
+  subroutine generic_mlres_init(tracer_list)
+    type(g_tracer_type), pointer :: tracer_list
+
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_init'
+
+    !Specify and initialize all parameters used by this package
+    call user_add_params
+
+    !Allocate and initiate all the private work arrays used by this module.
+    !call user_allocate_arrays 
+
+  end subroutine generic_mlres_init
+
+  subroutine user_allocate_arrays
+
+    ! Nothing to do for mixed layer tracer
+    ! call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau) 
+
+  end subroutine user_allocate_arrays
+
+  subroutine user_deallocate_arrays
+  !   This is an internal sub, not a public interface.
+  !   Deallocate all the work arrays allocated by user_allocate_arrays.
+  !
+  end subroutine user_deallocate_arrays
+  !
+  !   This is an internal sub, not a public interface.
+  !   Add all the parameters to be used in this module. 
+  !
+  subroutine user_add_params
+
+    !Specify all parameters used in this modules.
+    !==============================================================
+    !User adds one call for each parameter below!
+    !User also adds the definition of each parameter in generic_mlres_params type
+    !==============================================================    
+
+    !=============
+    !Block Starts: g_tracer_add_param
+    !=============
+    !Add the known experimental parameters used for calculations
+    !in this module.
+    !All the g_tracer_add_param calls must happen between 
+    !g_tracer_start_param_list and g_tracer_end_param_list  calls.
+    !This implementation enables runtime overwrite via field_table.
+
+    call g_tracer_start_param_list(package_name)
+    !  Rho_0 is used in the Boussinesq
+    !  approximation to calculations of pressure and
+    !  pressure gradients, in units of kg m-3.
+    call g_tracer_add_param('RHO_0', param%Rho_0, 1035.0)
+
+    call g_tracer_end_param_list(package_name)
+    !===========
+    !Block Ends: g_tracer_add_param
+    !===========
+
+  end subroutine user_add_params
+
+  !
+  !   This is an internal sub, not a public interface.
+  !   Add all the tracers to be used in this module. 
+  !
+  subroutine user_add_tracers(tracer_list)
+    type(g_tracer_type), pointer :: tracer_list
+
+    character(len=fm_string_len), parameter :: sub_name = 'user_add_tracers'
+
+    call g_tracer_start_param_list(package_name)!nnz: Does this append?
+    call g_tracer_add_param('ice_restart_file'   , param%ice_restart_file   , 'ice_ocmip_mlres.res.nc')
+    call g_tracer_add_param('ocean_restart_file' , param%ocean_restart_file , 'ocmip_mlres.res.nc' )
+    call g_tracer_add_param('IC_file'       , param%IC_file       , '')
+    call g_tracer_end_param_list(package_name)
+
+    ! Set Restart files
+    call g_tracer_set_files(ice_restart_file=param%ice_restart_file, ocean_restart_file=param%ocean_restart_file )
+
+    !=====================================================
+    !Specify all prognostic tracers of this modules.
+    !=====================================================
+    !User adds one call for each prognostic tracer below!
+    !User should specify if fluxes must be extracted from boundary 
+    !by passing one or more of the following methods as .true.  
+    !and provide the corresponding parameters array
+    !methods: flux_gas,flux_runoff,flux_wetdep,flux_drydep  
+    !
+    !prog_tracers: mlres
+    !diag_tracers: none
+    !
+    !age
+    call g_tracer_add(tracer_list,package_name,               &
+         name          = 'mlres',                             &
+         longname      = 'residence time inside mixed layer', &
+         units         = 'years',                             &
+         init_value    = 0.0,                                 &
+         prog          = .true.)
+
+    call g_tracer_add(tracer_list,package_name,                &
+         name          = 'mlres_inv',                          &
+         longname      = 'residence time outside mixed layer', &
+         units         = 'years',                              &
+         init_value    = 0.0,                                  &
+         prog          = .true.)
+
+
+  end subroutine user_add_tracers
+
+  ! <SUBROUTINE NAME="generic_mlres_update_from_coupler">
+  !  <OVERVIEW>
+  !   Modify the values obtained from the coupler if necessary.
+  !  </OVERVIEW>
+  !  <DESCRIPTION>
+  !   Currently an empty stub for ages.
+  !   Some tracer fields need to be modified after values are obtained from the coupler.
+  !   This subroutine is the place for specific tracer manipulations.
+  !  </DESCRIPTION>
+  !  <TEMPLATE>
+  !   call generic_mlres_update_from_coupler(tracer_list) 
+  !  </TEMPLATE>
+  !  <IN NAME="tracer_list" TYPE="type(g_tracer_type), pointer">
+  !   Pointer to the head of generic tracer list.
+  !  </IN>
+  ! </SUBROUTINE>
+  subroutine generic_mlres_update_from_coupler(tracer_list)
+    type(g_tracer_type), pointer :: tracer_list
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_update_from_coupler'
+    !
+    !Nothing specific to be done for mixed layer residence tracers
+    !
+    return
+  end subroutine generic_mlres_update_from_coupler
+
+  ! <SUBROUTINE NAME="generic_mlres_update_from_source">
+  !  <OVERVIEW>
+  !   Update tracer concentration fields due to the source/sink contributions.
+  !  </OVERVIEW>
+  !  <DESCRIPTION>
+  !   Sets age to zero in uppermost level and increments it by the time step elsewhere
+  !  </DESCRIPTION>
+  ! </SUBROUTINE>
+  subroutine generic_mlres_update_from_source( tracer_list,tau,dt,       &
+                                               hblt_depth,dzt,ilb,jlb  )
+
+    type(g_tracer_type),            pointer    :: tracer_list
+    integer,                        intent(in) :: tau, ilb, jlb
+    real,                           intent(in) :: dt
+    real, dimension(ilb:,jlb:),     intent(in) :: hblt_depth
+    real, dimension(ilb:,jlb:,:),   intent(in) :: dzt
+
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_update_from_source'
+    integer                                 :: isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,i,j,k
+    real, parameter                         :: secs_in_year_r = 1.0 / (86400.0 * 365.25)
+    real, dimension(:,:,:)  , pointer       :: grid_tmask
+    real, dimension(:,:,:,:), pointer       :: p_mlres_field, p_mlres_inv_field
+
+    real, dimension(:,:,:), allocatable :: zt
+
+    call g_tracer_get_common(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,grid_tmask=grid_tmask)
+
+    allocate( zt(isd:ied,jsd:jed,nk) ); zt=0.0
+
+    call g_tracer_get_pointer(tracer_list, 'mlres'    , 'field', p_mlres_field    )
+    call g_tracer_get_pointer(tracer_list, 'mlres_inv', 'field', p_mlres_inv_field)
+
+    ! Compute depth of the bottom of the cell
+    zt = 0.0
+    do j = jsc, jec ; do i = isc, iec   !{
+       zt(i,j,1) = dzt(i,j,1)
+    enddo; enddo !} i,j
+    do k = 2, nk ; do j = jsc, jec ; do i = isc, iec   !{
+       zt(i,j,k) = zt(i,j,k-1) + dzt(i,j,k)
+    enddo; enddo; enddo !} i,j
+
+    do k = 1, nk; do j = jsc, jec ; do i = isc, iec
+
+      if (zt(i,j,k) .le. hblt_depth(i,j) ) then
+        !if ( p_mlres_inv_field(i,j,k,tau) .gt. 1 ) then
+        if ( p_mlres_inv_field(i,j,k,tau) .gt. reset_time ) then
+          ! Reset tracers
+          p_mlres_field    (i,j,k,tau) = 0.0
+          p_mlres_inv_field(i,j,k,tau) = 0.0
+        else
+          p_mlres_field(i,j,k,tau) = p_mlres_field(i,j,k,tau) + dt*secs_in_year_r*grid_tmask(i,j,k)
+        endif
+      else
+        p_mlres_inv_field(i,j,k,tau) = p_mlres_inv_field(i,j,k,tau) + dt*secs_in_year_r*grid_tmask(i,j,k)
+      endif
+
+    enddo; enddo; enddo !} i,j,k
+
+    deallocate (zt)
+
+    return
+  end subroutine generic_mlres_update_from_source
+
+  ! <SUBROUTINE NAME="generic_mlres_set_boundary_values">
+  !  <OVERVIEW>
+  !   Calculate and set coupler values at the surface / bottom
+  !  </OVERVIEW>
+  !  <DESCRIPTION>
+  !   
+  !  </DESCRIPTION>
+  !  <TEMPLATE>
+  !   call generic_mlres_set_boundary_values(tracer_list,SST,SSS,rho,ilb,jlb,tau)
+  !  </TEMPLATE>
+  !  <IN NAME="tracer_list" TYPE="type(g_tracer_type), pointer">
+  !   Pointer to the head of generic tracer list.
+  !  </IN>
+  !  <IN NAME="ilb,jlb" TYPE="integer">
+  !   Lower bounds of x and y extents of input arrays on data domain
+  !  </IN>
+  !  <IN NAME="SST" TYPE="real, dimension(ilb:,jlb:)">
+  !   Sea Surface Temperature   
+  !  </IN>
+  !  <IN NAME="SSS" TYPE="real, dimension(ilb:,jlb:)">
+  !   Sea Surface Salinity
+  !  </IN>
+  !  <IN NAME="rho" TYPE="real, dimension(ilb:,jlb:,:,:)">
+  !   Ocean density
+  !  </IN>
+  !  <IN NAME="tau" TYPE="integer">
+  !   Time step index of %field
+  !  </IN>
+  ! </SUBROUTINE>
+
+  !User must provide the calculations for these boundary values.
+  subroutine generic_mlres_set_boundary_values(tracer_list,ST,SSS,rho,ilb,jlb,taum1)
+    type(g_tracer_type),          pointer    :: tracer_list
+    real, dimension(ilb:,jlb:),     intent(in) :: ST, SSS 
+    real, dimension(ilb:,jlb:,:,:), intent(in) :: rho
+    integer,                        intent(in) :: ilb,jlb,taum1
+
+    integer :: isc,iec, jsc,jec,isd,ied,jsd,jed,nk,ntau , i, j
+    real    :: conv_fac,sal,ta,SST,alpha,sc
+    real, dimension(:,:,:)  ,pointer  :: grid_tmask
+    real, dimension(:,:,:,:), pointer :: g_mlres_field
+    real, dimension(:,:), ALLOCATABLE :: g_mlres_alpha,g_mlres_csurf
+    real, dimension(:,:), ALLOCATABLE :: sc_no
+
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_set_boundary_values'
+
+    return
+  end subroutine generic_mlres_set_boundary_values
+
+  ! <SUBROUTINE NAME="generic_mlres_end">
+  !  <OVERVIEW>
+  !   End the module.
+  !  </OVERVIEW>
+  !  <DESCRIPTION>
+  !   Deallocate all work arrays
+  !  </DESCRIPTION>
+  !  <TEMPLATE>
+  !   call generic_mlres_end
+  !  </TEMPLATE>
+  ! </SUBROUTINE>
+
+  subroutine generic_mlres_end
+    character(len=fm_string_len), parameter :: sub_name = 'generic_mlres_end'
+    !call user_deallocate_arrays
+
+  end subroutine generic_mlres_end
+
+end module generic_mlres