!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
MODULE overflows 7,26
!BOP
! !MODULE: overflows
! !DESCRIPTION:
! This module contains data types and routines for computing
! parameterized overflows. Overflows are sub-grid scale flows
! along topography thought to be important for bottom water
! formation.
!
! !REVISION HISTORY:
! SVN:
!
! !USES:
use POP_KindsMod
use POP_ErrorMod
use POP_BlocksMod
use POP_CommMod
use POP_ConfigMod
use POP_DistributionMod
use POP_DomainSizeMod
use POP_FieldMod
use POP_GridHorzMod
use POP_HaloMod
use POP_RedistributeMod
use POP_SolversMod
use blocks
use broadcast
use communicate
use constants
use domain
use exit_mod
use global_reductions
use grid
use io_types
use kinds_mod
use prognostic
use time_management
use registry
!*** ccsm
use gather_scatter
use shr_sys_mod
implicit none
private
save
! !PUBLIC MEMBER FUNCTIONS:
public :: init_overflows1, & ! initial.F90
init_overflows2, & ! initial.F90
init_overflows_kmt, &
init_overflows_mask, &
init_overflows3, & ! initial.F90
init_overflows4, & ! initial.F90
init_overflows5, & ! initial.F90
ovf_write_restart, & ! step_mod.F90
ovf_read_restart, & ! init_overflows1
ovf_read_broadcast, &
ovf_advt, & ! advection.F90
ovf_wtkb_check, & ! advection.F90
ovf_UV_check, &
ovf_Utlda, & ! baroclinic.F90
ovf_driver, & ! step_mod.F90
ovf_reg_avgs, &
ovf_transports, &
ovf_state, &
ovf_loc_prd, &
ovf_W, &
ovf_UV, &
ovf_rhs_brtrpc_momentum, & ! barotropic.F90
ovf_brtrpc_renorm, & ! barotropic.F90
ovf_rhs_brtrpc_continuity, & ! barotropic.F90
ovf_solvers_9pt, & ! barotropic.F90
ovf_HU, &
ovf_UV_solution ! step_mod.F90
! !PUBLIC DATA MEMBERS:
!-----------------------------------------------------------------------
! list of nomenclature definitions
!-----------------------------------------------------------------------
!
! ovf = overflow
! inf = inflow (refering to inflow region)
! src = source (either region or grid box)
! ent = entrainment (either region or grid box)
! prd = product (either region or grid box)
! reg = region (for averaging density and tracers over region)
! adj = adjacent (for averaging density and tracers over adjacent boxes)
! num = number (usually refers to actual number used based on input)
! no. = number (usually refers to actual number used based on input)
! locs = locations (i.e. grid boxes)
! orient = orientation (1,2,3 or 4; refers to grid box sidewall)
! params = parameters
! ssb = shelf-slope break- shelf/slope transition to abyssal depth
!
!-----------------------------------------------------------------------
! define overflow types and parameters
!-----------------------------------------------------------------------
logical (log_kind), public :: &
overflows_on, & ! true=on, false=off
overflows_interactive ! true=interactive ovf
character (POP_charLength) :: &
overflows_infile, &! overflow info file
overflows_diag_outfile, &! current filename for overflow output diagnostics file
outfile_tmp ! temp for appending to outfile name
character (POP_charLength), public :: &
overflows_restart_type, &! restart type (ccsm_startup, ccsm_continue, ccsm_hybrid, ccsm_branch)
overflows_restfile ! overflow restart file name
integer (int_kind), parameter, public :: &
max_ovf = 10,& ! max no. ocean overflows
max_kmt = 200,& ! max no. overflow kmt changes
max_src = 50,& ! max no. overflow src locations
max_ent = 50,& ! max no. overflow ent locations
max_prd_sets = 20,& ! max no. overflow prd sets
max_prd = 50 ! max no. overflow prd locs each set
integer (int_kind), public :: &
num_ovf ! no. of overflows from ovf info file
type, public :: ovf_params ! parameters for each overflow
real (r8) :: &
lat ,& ! latitude (degrees)
width ,& ! strait width (cm)
source_thick ,& ! source water thickness (cm)
distnc_str_ssb ,& ! distance strait to ssb (cm)
bottom_slope ,& ! bottom slope beyond ssb
bottom_drag ! bottom drag coefficient
end type ovf_params
type, public :: ovf_kmtbox ! overflow grid-box for kmt changes
integer (int_kind) :: &
i ,& ! x index
j ,& ! y index
korg ,& ! original kmt value
knew ! new kmt value
end type ovf_kmtbox
type, public :: ovf_region ! overflow regional boundaries
integer (int_kind) :: &
imin ,& ! x index min
imax ,& ! x index max
jmin ,& ! y index min
jmax ,& ! y index ma
kmin ,& ! z index min
kmax ! z index max
end type ovf_region
type, public :: ovf_mask_reg ! overflow regional mask
real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
inf ,& ! inflow region mask
src ,& ! source region mask
ent ! entrainment region mask
end type ovf_mask_reg
type, public :: ovf_mask_adj ! overflow adjacent mask
real (r8) :: src(nx_block,ny_block,max_blocks_clinic), & ! src adj mask
ent(nx_block,ny_block,max_blocks_clinic) ! ent adj mask
real (r8) :: prd(nx_block,ny_block,max_blocks_clinic,max_prd_sets) ! prd adj mask(s)
end type ovf_mask_adj
type, public :: ovf_mask_reg_wght ! overflow regional mask weight
real (r8) :: &
inf ,& ! inflow region mask weight
src ,& ! source region mask weight
ent ! entrainment region mask weight
end type ovf_mask_reg_wght
type, public :: ovf_mask_adj_wght ! overflow adjacent mask weight
real (r8) :: &
src ,& ! source adj mask weight
ent ,& ! entrainment adj mask weight
prd(max_prd_sets) ! product adj mask weight(s)
end type ovf_mask_adj_wght
type, public :: ovf_trcr_reg ! overflow regional tracers
real (r8), dimension(nt) :: &
inf ,& ! inflow region tracers
src ,& ! source region tracers
ent ,& ! entrainment region tracers
prd ! product region tracers
end type ovf_trcr_reg
type, public :: ovf_trcr_adj ! overflow adjacent tracers
real (r8), dimension(nt) :: &
src ,& ! source adj tracers
ent ,& ! entrainment adj tracers
prd ! product adj tracers
end type ovf_trcr_adj
type, public :: ovf_rho_reg ! overflow regional density
real (r8) :: &
inf ,& ! inflow region density
src ,& ! source region density
ent ! entrainment region density
end type ovf_rho_reg
type, public :: ovf_rho_adj ! overflow adj density
real (r8) :: &
prd(max_prd_sets) ! product region density(s)
end type ovf_rho_adj
type, public :: ovf_gridbox ! overflow grid-box info
integer (int_kind) :: &
i ,& ! x index for t grid
j ,& ! y index for t grid
k ,& ! z index for t grid
orient ,& ! sidewall orientation of t grid box
i_adv ,& ! x index for t grid advection
j_adv ,& ! y index for t grid advection
i_u ,& ! x index for u grid
j_u ,& ! y index for u grid
task_u ! task number for (i_u,j_u)
real (r8) :: &
Utlda(km) ,& ! UVEL "tilda" at (n+1) column speed on u grid
Vtlda(km) ,& ! VVEL "tilda" at (n+1) column speed on u grid
Uovf_nm1 ,& ! U at (n-1) speed on u grid
Uovf_n ,& ! U at (n) speed on u grid
Uovf ,& ! U at (n+1) speed on u grid
Wovf ! W at (n+1) vert speed on t grid
end type ovf_gridbox
!-------------------------------------------------------------------------------
! type overflow that follows contains all diagnostic and prognostic
! data for each overflow; complete list for all overflows is contained
! in the array ovf. each overflow is specified by regions, grid locations,
! and adjacent locations. inf (inflow) and src (source) regions are
! geographically specified volumes from which density differences
! determine source transport Ms. this transport is assumed to flow into
! sidewall locations (possibly modified from original topography by any
! kmt changes) given by src locations, transporting mean tracers from
! adjacent grid boxes to the sidewall specified by adjacent boundaries.
! this transport moves unimpeded to the ent (entrainment) locations, where
! an entrainment region density along with source density (adjusted for
! depth changes) determines mixing. entrainment tracers from means along
! adjacent entrainment grid boxes are mixed with source tracers resulting
! in a total transport Mp and mixed product tracers. this product is then
! injected from a product sidewall for which the product density is neutral
! with the adjacent mean density. each product set is a group of points,
! and the collection of sets represents a product path of increasing depth.
!
! the reader is to be commended for taking in this tedious explanation.
! it is unfortunately necessary to explain the complexity of the overflow
! parameterization.
!-------------------------------------------------------------------------------
type, public :: overflow ! individual overflow info
! logicals and name
logical (log_kind) :: interactive ! T=ovf active with ocn
character (32) :: name ! name of ovf
! parameters
type (ovf_params) :: ovf_params ! ovf specific params
! kmt mods
integer (int_kind) :: num_kmt ! no. of kmt changes
type (ovf_kmtbox) :: loc_kmt(max_kmt) ! kmt locs
! source locations
integer (int_kind) :: num_src ! no. of src locs
type (ovf_gridbox) :: loc_src(max_src) ! src locs
! entrainment locations
integer (int_kind) :: num_ent ! no. of ent locs
type (ovf_gridbox) :: loc_ent(max_ent) ! ent locs
! product sets (various injection locations) and point for each
integer (int_kind) :: num_prd_sets ! no. prd sets of pnts
integer (int_kind) :: num_prd(max_prd_sets) ! no. prd locs each set
type (ovf_gridbox) :: loc_prd(max_prd_sets,max_prd) ! prd locs
! region locations, masks, tracer and density means for inf, src and ent
type (ovf_region) :: reg_inf ! inf reg boundaries
type (ovf_region) :: reg_src ! src reg boundaries
type (ovf_region) :: reg_ent ! ent reg boundaries
type (ovf_mask_reg) :: mask_reg ! regional inf, src, ent masks
type (ovf_mask_reg_wght) :: wght_reg ! regional mask weights
type (ovf_trcr_reg) :: trcr_reg ! regional tracers
type (ovf_rho_reg) :: rho_reg ! regional densities
! adjacent locations, masks, tracer and density means for src, ent and prd
type (ovf_region) :: adj_src ! src adj boundaries
type (ovf_region) :: adj_ent ! ent adj boundaries
type (ovf_region) :: adj_prd(max_prd_sets) ! prd adj boundaries
type (ovf_mask_adj) :: mask_adj ! adj mask
type (ovf_mask_adj_wght) :: wght_adj ! adj mask weights
type (ovf_trcr_adj) :: trcr_adj ! adjacent tracers
type (ovf_rho_adj) :: rho_adj ! regional densities
! overflow transports and state
real (r8) :: Ms ! src mass flux (Sv)
real (r8) :: Ms_n ! src mass flux (Sv) at n
real (r8) :: Ms_nm1 ! src mass flux (Sv) at n-1
real (r8) :: Me ! ent mass flux (Sv)
real (r8) :: Me_n ! ent mass flux (Sv) at n
real (r8) :: Me_nm1 ! ent mass flux (Sv) at n-1
real (r8) :: phi ! ent parameter (Me/Mp)
real (r8) :: Mp ! prd mass flux (Sv)
real (r8) :: Mp_n ! prd mass flux (Sv) at n
real (r8) :: Mp_nm1 ! prd mass flux (Sv) at n-1
real (r8) :: Tp ! prd temperature (C)
real (r8) :: Sp ! prd salinity (ppt)
integer (int_kind) :: prd_set_n ! prd set index previous time step
integer (int_kind) :: prd_set ! prd set index
end type overflow
type (overflow), dimension(max_ovf), public :: ovf ! contains all overflow info
integer (POP_i4) :: &
errorCode
!EOC
!-----------------------------------------------------------------------
!
! controls for frequency and output of diagnostics
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
ovf_diag_unit ! i/o unit for overflow output diagnostics file
character (char_len) :: &
ccsm_diag_date
logical (log_kind) :: &
lccsm = .false., &
lccsm_control_compatible = .false.
character (10) :: &
cdate ! character date
!***********************************************************************
contains
!***********************************************************************
!EOP
! !IROUTINE: init_overflows1
! !INTERFACE:
subroutine init_overflows1 1,109
! !DESCRIPTION:
! This routine is the first of four which together initialize the overflow
! parameterization. It reads the namelist and overflow_infile (text file
! containing ovf info). See info file comments for description of text file
! format. This routine also computes prd region limits based on prd input,
! writes out to stdout and overflows_diag_outfile, and then broadcasts ovf info
! to all processors.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
namelist /overflows_nml/ overflows_on, overflows_interactive, &
overflows_infile, overflows_diag_outfile, &
overflows_restart_type, overflows_restfile
integer (i4) :: &
index, &! overflow index
nu, &! unit for overflow input file
nml_error, &! namelist i/o error flag
ovf_error, &! ovf i/o error flag
num_req, &! number requested for error message
imin, &! i index for checking input order
jmin, &! j index for checking input order
kmin, &! k index for checking input number of levels
ornt ! orientation for checking constancy
character (88) :: line ! temporary for line of text input/output
integer (int_kind) :: &
n, &! ovf loop index
m, &! sub-ovf loop index
nn, &! tracer loop index
mp, &! sub-ovf sub-loop index
i,j, &! horizontal loop indices
k, &! vertical loop index
iblock, &! local block address
ib,ie,jb,je, &! local domain index boundaries
di,dj ! orientation adjustments in i,j
type (block) :: &
this_block ! block information for current block
!-----------------------------------------------------------------------
! read overflow namelist
!-----------------------------------------------------------------------
if (my_task == master_task) then
write(stdout,blank_fmt)
write(stdout,ndelim_fmt)
write(stdout,blank_fmt)
write(stdout,'(a11)') ' Overflows:'
write(stdout,blank_fmt)
call shr_sys_flush(stdout)
endif
overflows_on = .false.
overflows_interactive = .false.
overflows_infile = 'unknown_ovf_infile'
overflows_diag_outfile = 'unknown_ovf_outfile'
overflows_restart_type = 'ccsm_startup'
overflows_restfile = 'unknown_ovf_restfile'
if (my_task == master_task) then
open (nml_in, file=nml_filename, status='old',iostat=nml_error)
if (nml_error /= 0) then
nml_error = -1
else
nml_error = 1
endif
do while (nml_error > 0)
read(nml_in, nml=overflows_nml,iostat=nml_error)
end do
if (nml_error == 0) close(nml_in)
endif
call broadcast_scalar(nml_error, master_task)
if (nml_error /= 0) then
call exit_POP(sigAbort,'ERROR reading overflows_nml')
endif
if (my_task == master_task) then
write(stdout,blank_fmt)
write(stdout,'(a33)') ' overflows_nml namelist settings:'
write(stdout,blank_fmt)
write(stdout,overflows_nml)
write(stdout,blank_fmt)
call shr_sys_flush(stdout)
endif
call broadcast_scalar(overflows_on, master_task)
call broadcast_scalar(overflows_interactive, master_task)
call broadcast_scalar(overflows_infile, master_task)
call broadcast_scalar(overflows_diag_outfile, master_task)
call broadcast_scalar(overflows_restart_type, master_task)
call broadcast_scalar(overflows_restfile, master_task)
!-----------------------------------------------------------------------
! if overflows off, exit
!-----------------------------------------------------------------------
if( .not. overflows_on ) return
!-----------------------------------------------------------------------
!
! determine if this is a ccsm coupled run
! determine if this case must be backwards compatible with CCSM control
!-----------------------------------------------------------------------
lccsm = registry_match('lccsm')
lccsm_control_compatible = registry_match('lccsm_control_compatible')
!-----------------------------------------------------------------------
! overflows on; read overflows info file if ccsm_startup; otherwise
! read restart data
!-----------------------------------------------------------------------
if( overflows_restart_type == 'ccsm_startup' ) then
ovf_error = 0
call get_unit(nu)
!-----------------------------------------------------------------------
! master task section
!-----------------------------------------------------------------------
if (my_task == master_task) then
open(nu, file=overflows_infile, status='old',iostat=ovf_error)
write(stdout,2345) ovf_error
2345 format(' after open nu ovf_error=',i5)
write(stdout,'(a41)') 'reading overflows_infile: contents echoed'
call shr_sys_flush(stdout)
do m=1,40
read(nu,'(a88)') line
write(stdout,'(a88)') line
end do
read(nu,*) num_ovf
write(stdout,*) num_ovf
call shr_sys_flush(stdout)
if( num_ovf <= 0 .or. num_ovf > max_ovf ) then
ovf_error = 1
num_req = num_ovf
goto 10
endif
do n=1,num_ovf
ovf(n)%interactive = overflows_interactive
read(nu,*) index,ovf(n)%name
write(stdout,*) index,ovf(n)%name
read(nu,*) ovf(n)%ovf_params%lat
read(nu,*) ovf(n)%ovf_params%width
read(nu,*) ovf(n)%ovf_params%source_thick
read(nu,*) ovf(n)%ovf_params%distnc_str_ssb
read(nu,*) ovf(n)%ovf_params%bottom_slope
read(nu,*) ovf(n)%ovf_params%bottom_drag
write(stdout,*) ovf(n)%ovf_params%lat
write(stdout,*) ovf(n)%ovf_params%width
write(stdout,*) ovf(n)%ovf_params%source_thick
write(stdout,*) ovf(n)%ovf_params%distnc_str_ssb
write(stdout,*) ovf(n)%ovf_params%bottom_slope
write(stdout,*) ovf(n)%ovf_params%bottom_drag
call shr_sys_flush(stdout)
! kmt changes if any
read(nu,*) ovf(n)%num_kmt
write(stdout,*) ovf(n)%num_kmt
if( ovf(n)%num_kmt < 0 .or. ovf(n)%num_kmt > max_kmt ) then
ovf_error = 2
num_req = ovf(n)%num_kmt
goto 10
endif
do m=1,ovf(n)%num_kmt
read(nu,*) ovf(n)%loc_kmt(m)%i, &
ovf(n)%loc_kmt(m)%j, &
ovf(n)%loc_kmt(m)%korg, &
ovf(n)%loc_kmt(m)%knew
write(stdout,*) ovf(n)%loc_kmt(m)%i, &
ovf(n)%loc_kmt(m)%j, &
ovf(n)%loc_kmt(m)%korg, &
ovf(n)%loc_kmt(m)%knew
end do
call shr_sys_flush(stdout)
read(nu,*)
! inf,src and ent region limits
read(nu,*) ovf(n)%reg_inf%imin, &
ovf(n)%reg_inf%imax, &
ovf(n)%reg_inf%jmin, &
ovf(n)%reg_inf%jmax, &
ovf(n)%reg_inf%kmin, &
ovf(n)%reg_inf%kmax
read(nu,*) ovf(n)%reg_src%imin, &
ovf(n)%reg_src%imax, &
ovf(n)%reg_src%jmin, &
ovf(n)%reg_src%jmax, &
ovf(n)%reg_src%kmin, &
ovf(n)%reg_src%kmax
read(nu,*) ovf(n)%reg_ent%imin, &
ovf(n)%reg_ent%imax, &
ovf(n)%reg_ent%jmin, &
ovf(n)%reg_ent%jmax, &
ovf(n)%reg_ent%kmin, &
ovf(n)%reg_ent%kmax
write(stdout,*) ovf(n)%reg_inf%imin, &
ovf(n)%reg_inf%imax, &
ovf(n)%reg_inf%jmin, &
ovf(n)%reg_inf%jmax, &
ovf(n)%reg_inf%kmin, &
ovf(n)%reg_inf%kmax
write(stdout,*) ovf(n)%reg_src%imin, &
ovf(n)%reg_src%imax, &
ovf(n)%reg_src%jmin, &
ovf(n)%reg_src%jmax, &
ovf(n)%reg_src%kmin, &
ovf(n)%reg_src%kmax
write(stdout,*) ovf(n)%reg_ent%imin, &
ovf(n)%reg_ent%imax, &
ovf(n)%reg_ent%jmin, &
ovf(n)%reg_ent%jmax, &
ovf(n)%reg_ent%kmin, &
ovf(n)%reg_ent%kmax
call shr_sys_flush(stdout)
! src points
read(nu,*) ovf(n)%num_src
write(stdout,*) ovf(n)%num_src
if( ovf(n)%num_src <= 1 .or. ovf(n)%num_src > max_src ) then
ovf_error = 3
num_req = ovf(n)%num_src
goto 10
endif
do m=1,ovf(n)%num_src
read(nu,*) ovf(n)%loc_src(m)%i, &
ovf(n)%loc_src(m)%j, &
ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient
if ( ovf(n)%loc_src(m)%orient .eq. 1 ) then
ovf(n)%loc_src(m)%i_adv = ovf(n)%loc_src(m)%i + 1
ovf(n)%loc_src(m)%j_adv = ovf(n)%loc_src(m)%j
ovf(n)%loc_src(m)%i_u = ovf(n)%loc_src(m)%i
ovf(n)%loc_src(m)%j_u = ovf(n)%loc_src(m)%j
! some u corner points i_u,j_u zeroed because they are inactive
if( m == ovf(n)%num_src ) then
ovf(n)%loc_src(m)%i_u = 0
ovf(n)%loc_src(m)%j_u = 0
endif
else if( ovf(n)%loc_src(m)%orient .eq. 2 ) then
ovf(n)%loc_src(m)%i_adv = ovf(n)%loc_src(m)%i
ovf(n)%loc_src(m)%j_adv = ovf(n)%loc_src(m)%j + 1
ovf(n)%loc_src(m)%i_u = ovf(n)%loc_src(m)%i - 1
if(ovf(n)%loc_src(m)%i_u==0) ovf(n)%loc_src(m)%i_u = nx_global
ovf(n)%loc_src(m)%j_u = ovf(n)%loc_src(m)%j
if( m == 1 ) then
ovf(n)%loc_src(m)%i_u = 0
ovf(n)%loc_src(m)%j_u = 0
endif
else if( ovf(n)%loc_src(m)%orient .eq. 3 ) then
ovf(n)%loc_src(m)%i_adv = ovf(n)%loc_src(m)%i - 1
if(ovf(n)%loc_src(m)%i_adv==0) ovf(n)%loc_src(m)%i_adv = nx_global
ovf(n)%loc_src(m)%j_adv = ovf(n)%loc_src(m)%j
ovf(n)%loc_src(m)%i_u = ovf(n)%loc_src(m)%i - 1
if(ovf(n)%loc_src(m)%i_u==0) ovf(n)%loc_src(m)%i_u = nx_global
ovf(n)%loc_src(m)%j_u = ovf(n)%loc_src(m)%j - 1
if( m == 1 ) then
ovf(n)%loc_src(m)%i_u = 0
ovf(n)%loc_src(m)%j_u = 0
endif
else if( ovf(n)%loc_src(m)%orient .eq. 4 ) then
ovf(n)%loc_src(m)%i_adv = ovf(n)%loc_src(m)%i
ovf(n)%loc_src(m)%j_adv = ovf(n)%loc_src(m)%j - 1
ovf(n)%loc_src(m)%i_u = ovf(n)%loc_src(m)%i
ovf(n)%loc_src(m)%j_u = ovf(n)%loc_src(m)%j - 1
if( m == ovf(n)%num_src ) then
ovf(n)%loc_src(m)%i_u = 0
ovf(n)%loc_src(m)%j_u = 0
endif
endif
write(stdout,*) ovf(n)%loc_src(m)%i, &
ovf(n)%loc_src(m)%j, &
ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient
call shr_sys_flush(stdout)
! check order of ij, constancy of k and range of orient
if( m==1 ) then
imin = ovf(n)%loc_src(m)%i
jmin = ovf(n)%loc_src(m)%j
kmin = ovf(n)%loc_src(m)%k
if( ovf(n)%loc_src(m)%orient < 1 .or. &
ovf(n)%loc_src(m)%orient > 4 ) then
ovf_error = 11
goto 10
endif
ornt = ovf(n)%loc_src(m)%orient
else
if( ovf(n)%loc_src(m)%i < imin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_src(m)%j < jmin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_src(m)%i == imin .and. &
ovf(n)%loc_src(m)%j == jmin) then
ovf_error = 8
goto 10
endif
if( ovf(n)%loc_src(m)%i > imin .and. &
ovf(n)%loc_src(m)%j > jmin) then
ovf_error = 9
goto 10
endif
if( ovf(n)%loc_src(m)%k /= kmin ) then
ovf_error = 10
goto 10
endif
if( ovf(n)%loc_src(m)%orient < 1 .or. &
ovf(n)%loc_src(m)%orient > 4 ) then
ovf_error = 11
goto 10
endif
if( ovf(n)%loc_src(m)%orient /= ornt ) then
ovf_error = 12
goto 10
endif
imin = ovf(n)%loc_src(m)%i
jmin = ovf(n)%loc_src(m)%j
kmin = ovf(n)%loc_src(m)%k
ornt = ovf(n)%loc_src(m)%orient
endif
end do
! ent points
read(nu,*) ovf(n)%num_ent
write(stdout,*) ovf(n)%num_ent
if( ovf(n)%num_ent <= 1 .or. ovf(n)%num_ent > max_ent ) then
ovf_error = 4
num_req = ovf(n)%num_ent
goto 10
endif
do m=1,ovf(n)%num_ent
read(nu,*) ovf(n)%loc_ent(m)%i, &
ovf(n)%loc_ent(m)%j, &
ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient
if ( ovf(n)%loc_ent(m)%orient .eq. 1 ) then
ovf(n)%loc_ent(m)%i_adv = ovf(n)%loc_ent(m)%i + 1
ovf(n)%loc_ent(m)%j_adv = ovf(n)%loc_ent(m)%j
ovf(n)%loc_ent(m)%i_u = ovf(n)%loc_ent(m)%i
ovf(n)%loc_ent(m)%j_u = ovf(n)%loc_ent(m)%j
! some u corner points i_u,j_u zeroed because they are inactive
if( m == ovf(n)%num_ent ) then
ovf(n)%loc_ent(m)%i_u = 0
ovf(n)%loc_ent(m)%j_u = 0
endif
else if( ovf(n)%loc_ent(m)%orient .eq. 2 ) then
ovf(n)%loc_ent(m)%i_adv = ovf(n)%loc_ent(m)%i
ovf(n)%loc_ent(m)%j_adv = ovf(n)%loc_ent(m)%j + 1
ovf(n)%loc_ent(m)%i_u = ovf(n)%loc_ent(m)%i - 1
if(ovf(n)%loc_ent(m)%i_u==0) ovf(n)%loc_ent(m)%i_u = nx_global
ovf(n)%loc_ent(m)%j_u = ovf(n)%loc_ent(m)%j
if( m == 1 ) then
ovf(n)%loc_ent(m)%i_u = 0
ovf(n)%loc_ent(m)%j_u = 0
endif
else if( ovf(n)%loc_ent(m)%orient .eq. 3 ) then
ovf(n)%loc_ent(m)%i_adv = ovf(n)%loc_ent(m)%i - 1
if(ovf(n)%loc_ent(m)%i_adv==0) ovf(n)%loc_ent(m)%i_adv = nx_global
ovf(n)%loc_ent(m)%j_adv = ovf(n)%loc_ent(m)%j
ovf(n)%loc_ent(m)%i_u = ovf(n)%loc_ent(m)%i - 1
if(ovf(n)%loc_ent(m)%i_u==0) ovf(n)%loc_ent(m)%i_u = nx_global
ovf(n)%loc_ent(m)%j_u = ovf(n)%loc_ent(m)%j - 1
if( m == 1 ) then
ovf(n)%loc_ent(m)%i_u = 0
ovf(n)%loc_ent(m)%j_u = 0
endif
else if( ovf(n)%loc_ent(m)%orient .eq. 4 ) then
ovf(n)%loc_ent(m)%i_adv = ovf(n)%loc_ent(m)%i
ovf(n)%loc_ent(m)%j_adv = ovf(n)%loc_ent(m)%j - 1
ovf(n)%loc_ent(m)%i_u = ovf(n)%loc_ent(m)%i
ovf(n)%loc_ent(m)%j_u = ovf(n)%loc_ent(m)%j - 1
if( m == ovf(n)%num_ent ) then
ovf(n)%loc_ent(m)%i_u = 0
ovf(n)%loc_ent(m)%j_u = 0
endif
endif
write(stdout,*) ovf(n)%loc_ent(m)%i, &
ovf(n)%loc_ent(m)%j, &
ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient
call shr_sys_flush(stdout)
! check order of ij, constancy of k and range of orient
if( m==1 ) then
imin = ovf(n)%loc_ent(m)%i
jmin = ovf(n)%loc_ent(m)%j
kmin = ovf(n)%loc_ent(m)%k
if( ovf(n)%loc_ent(m)%orient < 1 .or. &
ovf(n)%loc_ent(m)%orient > 4 ) then
ovf_error = 11
goto 10
endif
ornt = ovf(n)%loc_ent(m)%orient
else
if( ovf(n)%loc_ent(m)%i < imin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_ent(m)%j < jmin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_ent(m)%i == imin .and. &
ovf(n)%loc_ent(m)%j == jmin) then
ovf_error = 8
goto 10
endif
if( ovf(n)%loc_ent(m)%i > imin .and. &
ovf(n)%loc_ent(m)%j > jmin) then
ovf_error = 9
goto 10
endif
if( ovf(n)%loc_ent(m)%k /= kmin ) then
ovf_error = 10
goto 10
endif
if( ovf(n)%loc_ent(m)%orient < 1 .or. &
ovf(n)%loc_ent(m)%orient > 4 ) then
ovf_error = 11
goto 10
endif
if( ovf(n)%loc_ent(m)%orient /= ornt ) then
ovf_error = 12
goto 10
endif
imin = ovf(n)%loc_ent(m)%i
jmin = ovf(n)%loc_ent(m)%j
kmin = ovf(n)%loc_ent(m)%k
ornt = ovf(n)%loc_ent(m)%orient
endif
end do
call shr_sys_flush(stdout)
! prd points
read(nu,*) ovf(n)%num_prd_sets
write(stdout,*) ovf(n)%num_prd_sets
if(ovf(n)%num_prd_sets<=0.or.ovf(n)%num_prd_sets>max_prd_sets) then
ovf_error = 5
num_req = ovf(n)%num_prd_sets
goto 10
endif
do m=1,ovf(n)%num_prd_sets
read(nu,*) ovf(n)%num_prd(m)
write(stdout,*) ovf(n)%num_prd(m)
if( ovf(n)%num_prd(m)<=1.or.ovf(n)%num_prd(m)>max_prd) then
ovf_error = 6
num_req = ovf(n)%num_prd(m)
goto 10
endif
do mp=1,ovf(n)%num_prd(m)
read(nu,*) ovf(n)%loc_prd(m,mp)%i, &
ovf(n)%loc_prd(m,mp)%j, &
ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient
if ( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) then
ovf(n)%loc_prd(m,mp)%i_adv = ovf(n)%loc_prd(m,mp)%i + 1
ovf(n)%loc_prd(m,mp)%j_adv = ovf(n)%loc_prd(m,mp)%j
ovf(n)%loc_prd(m,mp)%i_u = ovf(n)%loc_prd(m,mp)%i
ovf(n)%loc_prd(m,mp)%j_u = ovf(n)%loc_prd(m,mp)%j
! some u corner points i_u,j_u zeroed because they are inactive
if( mp == ovf(n)%num_prd(m) ) then
ovf(n)%loc_prd(m,mp)%i_u = 0
ovf(n)%loc_prd(m,mp)%j_u = 0
endif
else if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) then
ovf(n)%loc_prd(m,mp)%i_adv = ovf(n)%loc_prd(m,mp)%i
ovf(n)%loc_prd(m,mp)%j_adv = ovf(n)%loc_prd(m,mp)%j + 1
ovf(n)%loc_prd(m,mp)%i_u = ovf(n)%loc_prd(m,mp)%i - 1
if(ovf(n)%loc_prd(m,mp)%i_u==0) ovf(n)%loc_prd(m,mp)%i_u = nx_global
ovf(n)%loc_prd(m,mp)%j_u = ovf(n)%loc_prd(m,mp)%j
if( mp == 1 ) then
ovf(n)%loc_prd(m,mp)%i_u = 0
ovf(n)%loc_prd(m,mp)%j_u = 0
endif
else if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) then
ovf(n)%loc_prd(m,mp)%i_adv = ovf(n)%loc_prd(m,mp)%i - 1
if(ovf(n)%loc_prd(m,mp)%i_adv==0) ovf(n)%loc_prd(m,mp)%i_adv = nx_global
ovf(n)%loc_prd(m,mp)%j_adv = ovf(n)%loc_prd(m,mp)%j
ovf(n)%loc_prd(m,mp)%i_u = ovf(n)%loc_prd(m,mp)%i - 1
if(ovf(n)%loc_prd(m,mp)%i_u==0) ovf(n)%loc_prd(m,mp)%i_u = nx_global
ovf(n)%loc_prd(m,mp)%j_u = ovf(n)%loc_prd(m,mp)%j - 1
if( mp == 1 ) then
ovf(n)%loc_prd(m,mp)%i_u = 0
ovf(n)%loc_prd(m,mp)%j_u = 0
endif
else if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) then
ovf(n)%loc_prd(m,mp)%i_adv = ovf(n)%loc_prd(m,mp)%i
ovf(n)%loc_prd(m,mp)%j_adv = ovf(n)%loc_prd(m,mp)%j - 1
ovf(n)%loc_prd(m,mp)%i_u = ovf(n)%loc_prd(m,mp)%i
ovf(n)%loc_prd(m,mp)%j_u = ovf(n)%loc_prd(m,mp)%j - 1
if( mp == ovf(n)%num_prd(m) ) then
ovf(n)%loc_prd(m,mp)%i_u = 0
ovf(n)%loc_prd(m,mp)%j_u = 0
endif
endif
write(stdout,*) ovf(n)%loc_prd(m,mp)%i, &
ovf(n)%loc_prd(m,mp)%j, &
ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient
call shr_sys_flush(stdout)
! check order of ij, constancy of k and range of orient
if( mp==1 ) then
imin = ovf(n)%loc_prd(m,mp)%i
jmin = ovf(n)%loc_prd(m,mp)%j
kmin = ovf(n)%loc_prd(m,mp)%k
if( ovf(n)%loc_prd(m,mp)%orient < 1 .or. &
ovf(n)%loc_prd(m,mp)%orient > 4 ) then
ovf_error = 11
goto 10
endif
ornt = ovf(n)%loc_prd(m,mp)%orient
else
if( ovf(n)%loc_prd(m,mp)%i < imin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%j < jmin ) then
ovf_error = 7
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%i == imin .and. &
ovf(n)%loc_prd(m,mp)%j == jmin) then
ovf_error = 8
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%i > imin .and. &
ovf(n)%loc_prd(m,mp)%j > jmin) then
ovf_error = 9
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%k /= kmin ) then
ovf_error = 10
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%orient < 1 .or. &
ovf(n)%loc_prd(m,mp)%orient > 4 ) then
ovf_error = 11
goto 10
endif
if( ovf(n)%loc_prd(m,mp)%orient /= ornt ) then
ovf_error = 12
goto 10
endif
imin = ovf(n)%loc_prd(m,mp)%i
jmin = ovf(n)%loc_prd(m,mp)%j
kmin = ovf(n)%loc_prd(m,mp)%k
ornt = ovf(n)%loc_prd(m,mp)%orient
endif
end do
call shr_sys_flush(stdout)
end do
! find src adj limits
di = 0
dj = 0
if( ovf(n)%loc_src(1)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_src(1)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_src(1)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_src(1)%orient .eq. 4 ) dj = -1
ovf(n)%adj_src%imin = ovf(n)%loc_src(1)%i+di
ovf(n)%adj_src%jmin = ovf(n)%loc_src(1)%j+dj
ovf(n)%adj_src%kmin = ovf(n)%loc_src(1)%k
ovf(n)%adj_src%imax = ovf(n)%loc_src(1)%i+di
ovf(n)%adj_src%jmax = ovf(n)%loc_src(1)%j+dj
ovf(n)%adj_src%kmax = ovf(n)%loc_src(1)%k
do m=2,ovf(n)%num_src
di = 0
dj = 0
if( ovf(n)%loc_src(m)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_src(m)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_src(m)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_src(m)%orient .eq. 4 ) dj = -1
ovf(n)%adj_src%imin = min &
(ovf(n)%adj_src%imin,ovf(n)%loc_src(m)%i+di)
ovf(n)%adj_src%jmin = min &
(ovf(n)%adj_src%jmin,ovf(n)%loc_src(m)%j+dj)
ovf(n)%adj_src%kmin = min &
(ovf(n)%adj_src%kmin,ovf(n)%loc_src(m)%k)
ovf(n)%adj_src%imax = max &
(ovf(n)%adj_src%imax,ovf(n)%loc_src(m)%i+di)
ovf(n)%adj_src%jmax = max &
(ovf(n)%adj_src%jmax,ovf(n)%loc_src(m)%j+dj)
ovf(n)%adj_src%kmax = max &
(ovf(n)%adj_src%kmax,ovf(n)%loc_src(m)%k)
end do
! print src adj limits
write(stdout,13) &
ovf(n)%adj_src%imin, &
ovf(n)%adj_src%imax, &
ovf(n)%adj_src%jmin, &
ovf(n)%adj_src%jmax, &
ovf(n)%adj_src%kmin, &
ovf(n)%adj_src%kmax
13 format(' Computed source adjacent ijk min/max =',6(i4,2x))
! find ent adj limits
di = 0
dj = 0
if( ovf(n)%loc_ent(1)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_ent(1)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_ent(1)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_ent(1)%orient .eq. 4 ) dj = -1
ovf(n)%adj_ent%imin = ovf(n)%loc_ent(1)%i+di
ovf(n)%adj_ent%jmin = ovf(n)%loc_ent(1)%j+dj
ovf(n)%adj_ent%kmin = ovf(n)%loc_ent(1)%k
ovf(n)%adj_ent%imax = ovf(n)%loc_ent(1)%i+di
ovf(n)%adj_ent%jmax = ovf(n)%loc_ent(1)%j+dj
ovf(n)%adj_ent%kmax = ovf(n)%loc_ent(1)%k
do m=2,ovf(n)%num_ent
di = 0
dj = 0
if( ovf(n)%loc_ent(m)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_ent(m)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_ent(m)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_ent(m)%orient .eq. 4 ) dj = -1
ovf(n)%adj_ent%imin = min &
(ovf(n)%adj_ent%imin,ovf(n)%loc_ent(m)%i+di)
ovf(n)%adj_ent%jmin = min &
(ovf(n)%adj_ent%jmin,ovf(n)%loc_ent(m)%j+dj)
ovf(n)%adj_ent%kmin = min &
(ovf(n)%adj_ent%kmin,ovf(n)%loc_ent(m)%k)
ovf(n)%adj_ent%imax = max &
(ovf(n)%adj_ent%imax,ovf(n)%loc_ent(m)%i+di)
ovf(n)%adj_ent%jmax = max &
(ovf(n)%adj_ent%jmax,ovf(n)%loc_ent(m)%j+dj)
ovf(n)%adj_ent%kmax = max &
(ovf(n)%adj_ent%kmax,ovf(n)%loc_ent(m)%k)
end do
! print ent adj limits
write(stdout,14) &
ovf(n)%adj_ent%imin, &
ovf(n)%adj_ent%imax, &
ovf(n)%adj_ent%jmin, &
ovf(n)%adj_ent%jmax, &
ovf(n)%adj_ent%kmin, &
ovf(n)%adj_ent%kmax
14 format(' Computed entrainment adjacent ijk min/max =',6(i4,2x))
! find prd adj limits
do m=1,ovf(n)%num_prd_sets
di = 0
dj = 0
if( ovf(n)%loc_prd(m,1)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_prd(m,1)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_prd(m,1)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_prd(m,1)%orient .eq. 4 ) dj = -1
ovf(n)%adj_prd(m)%imin = ovf(n)%loc_prd(m,1)%i+di
ovf(n)%adj_prd(m)%jmin = ovf(n)%loc_prd(m,1)%j+dj
ovf(n)%adj_prd(m)%kmin = ovf(n)%loc_prd(m,1)%k
ovf(n)%adj_prd(m)%imax = ovf(n)%loc_prd(m,1)%i+di
ovf(n)%adj_prd(m)%jmax = ovf(n)%loc_prd(m,1)%j+dj
ovf(n)%adj_prd(m)%kmax = ovf(n)%loc_prd(m,1)%k
do mp=2,ovf(n)%num_prd(m)
di = 0
dj = 0
if( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) di = +1
if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) dj = +1
if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) di = -1
if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) dj = -1
ovf(n)%adj_prd(m)%imin = min &
(ovf(n)%adj_prd(m)%imin,ovf(n)%loc_prd(m,mp)%i+di)
ovf(n)%adj_prd(m)%jmin = min &
(ovf(n)%adj_prd(m)%jmin,ovf(n)%loc_prd(m,mp)%j+dj)
ovf(n)%adj_prd(m)%kmin = min &
(ovf(n)%adj_prd(m)%kmin,ovf(n)%loc_prd(m,mp)%k)
ovf(n)%adj_prd(m)%imax = max &
(ovf(n)%adj_prd(m)%imax,ovf(n)%loc_prd(m,mp)%i+di)
ovf(n)%adj_prd(m)%jmax = max &
(ovf(n)%adj_prd(m)%jmax,ovf(n)%loc_prd(m,mp)%j+dj)
ovf(n)%adj_prd(m)%kmax = max &
(ovf(n)%adj_prd(m)%kmax,ovf(n)%loc_prd(m,mp)%k)
end do
end do
! print prd adj limits
do m=1,ovf(n)%num_prd_sets
write(stdout,15) m, &
ovf(n)%adj_prd(m)%imin, &
ovf(n)%adj_prd(m)%imax, &
ovf(n)%adj_prd(m)%jmin, &
ovf(n)%adj_prd(m)%jmax, &
ovf(n)%adj_prd(m)%kmin, &
ovf(n)%adj_prd(m)%kmax
15 format(' Computed product adjacent, set=',i3, &
' ijk min/max =',6(i4,2x))
end do
end do ! ovf loop
call shr_sys_flush(stdout)
!-----------------------------------------------------------------------
! end master task section
!-----------------------------------------------------------------------
close (nu)
endif ! master_task
call release_unit(nu)
! error from goto 10
10 continue
call broadcast_scalar(ovf_error, master_task)
if (ovf_error /= 0) then
call broadcast_scalar(num_req, master_task)
write(stdout,*) 'ERROR on overflow input'
if( ovf_error == 1 ) then
write(stdout,*) 'Overflows on but number requested out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be > 0 and not greater than ',max_ovf
else if ( ovf_error == 2 ) then
write(stdout,*) 'Overflows on with kmt topography changes out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be >= 0 and not greater than ',max_kmt
else if ( ovf_error == 3 ) then
write(stdout,*) 'Overflows on with number source points out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be > 1 and not greater than ',max_src
else if ( ovf_error == 4 ) then
write(stdout,*) 'Overflows on with number entrainment points out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be > 1 and not greater than ',max_ent
else if ( ovf_error == 5 ) then
write(stdout,*) 'Overflows on with number of product sets out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be > 0 and not greater than ',max_prd_sets
else if ( ovf_error == 6 ) then
write(stdout,*) 'Overflows on with number of product points out of range'
write(stdout,*) 'Number requested = ',num_req
write(stdout,*) 'Must be > 1 and not greater than ',max_prd
else if ( ovf_error == 7 ) then
write(stdout,*) 'Overflows on with non-monotonic increasing i or j'
else if ( ovf_error == 8 ) then
write(stdout,*) 'Overflows on with no change in i and j'
else if ( ovf_error == 9 ) then
write(stdout,*) 'Overflows on with both i and j increasing'
else if ( ovf_error == 10 ) then
write(stdout,*) 'Overflows on with non-constant level k'
else if ( ovf_error == 11 ) then
write(stdout,*) 'Overflows on with orientation either < 0 or > 4'
else if ( ovf_error == 12 ) then
write(stdout,*) 'Overflows on with non-constant orientation'
endif
call shr_sys_flush(stdout)
call exit_POP(sigAbort,'ERROR reading overflows_infile')
endif ! ovf error
!-----------------------------------------------------------------------
! broadcast overflows info to all processors
!-----------------------------------------------------------------------
call broadcast_scalar(num_ovf, master_task)
do n=1,num_ovf
call broadcast_scalar(ovf(n)%interactive, master_task)
call broadcast_scalar(ovf(n)%name, master_task)
! ovf data
call broadcast_scalar(ovf(n)%ovf_params%lat, master_task)
call broadcast_scalar(ovf(n)%ovf_params%width, master_task)
call broadcast_scalar(ovf(n)%ovf_params%source_thick, master_task)
call broadcast_scalar(ovf(n)%ovf_params%distnc_str_ssb, master_task)
call broadcast_scalar(ovf(n)%ovf_params%bottom_slope, master_task)
call broadcast_scalar(ovf(n)%ovf_params%bottom_drag, master_task)
! kmt locations
call broadcast_scalar(ovf(n)%num_kmt, master_task)
do m=1,ovf(n)%num_kmt
call broadcast_scalar(ovf(n)%loc_kmt(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%korg, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%knew, master_task)
end do
! regional boundaries
! inflow
call broadcast_scalar(ovf(n)%reg_inf%imin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%imax, master_task)
call broadcast_scalar(ovf(n)%reg_inf%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_inf%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%kmax, master_task)
! source
call broadcast_scalar(ovf(n)%reg_src%imin, master_task)
call broadcast_scalar(ovf(n)%reg_src%imax, master_task)
call broadcast_scalar(ovf(n)%reg_src%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_src%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_src%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_src%kmax, master_task)
! entrainment
call broadcast_scalar(ovf(n)%reg_ent%imin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%imax, master_task)
call broadcast_scalar(ovf(n)%reg_ent%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_ent%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%kmax, master_task)
! src locs and orientation
call broadcast_scalar(ovf(n)%num_src, master_task)
do m=1,ovf(n)%num_src
call broadcast_scalar(ovf(n)%loc_src(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%k, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%orient, master_task)
end do
! ent locs and orientation
call broadcast_scalar(ovf(n)%num_ent, master_task)
do m=1,ovf(n)%num_ent
call broadcast_scalar(ovf(n)%loc_ent(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%k, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%orient, master_task)
end do
! prd locs and orientation
call broadcast_scalar(ovf(n)%num_prd_sets, master_task)
do m=1,ovf(n)%num_prd_sets
call broadcast_scalar(ovf(n)%num_prd(m), master_task)
do mp=1,ovf(n)%num_prd(m)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%k, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%orient, master_task)
end do
end do
! adjacent boundaries
call broadcast_scalar(ovf(n)%adj_src%imin, master_task)
call broadcast_scalar(ovf(n)%adj_src%imax, master_task)
call broadcast_scalar(ovf(n)%adj_src%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_src%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_src%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_src%kmax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%imin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%imax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%kmax, master_task)
do m=1,ovf(n)%num_prd_sets
call broadcast_scalar(ovf(n)%adj_prd(m)%imin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%imax, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%kmax, master_task)
end do
end do ! ovf broadcast loop
!-----------------------------------------------------------------------
! initialize overflow data for all processors, so no need to broadcast
!-----------------------------------------------------------------------
do n=1,num_ovf
ovf(n)%Ms = c0
ovf(n)%Ms_n = c0
ovf(n)%Ms_nm1 = c0
ovf(n)%Me = c0
ovf(n)%Me_n = c0
ovf(n)%Me_nm1 = c0
ovf(n)%phi = c0
ovf(n)%Mp = c0
ovf(n)%Mp_n = c0
ovf(n)%Mp_nm1 = c0
ovf(n)%wght_reg%inf = c0
ovf(n)%wght_reg%src = c0
ovf(n)%wght_reg%ent = c0
do m=1,ovf(n)%num_prd_sets
ovf(n)%wght_adj%prd(m) = c0
end do
ovf(n)%rho_reg%inf = c0
ovf(n)%rho_reg%src = c0
ovf(n)%rho_reg%ent = c0
do m=1,ovf(n)%num_prd_sets
ovf(n)%rho_adj%prd(m) = c0
end do
ovf(n)%prd_set_n = 1
ovf(n)%prd_set = 1
do nn=1,nt
ovf(n)%trcr_reg%inf(nn) = c0
ovf(n)%trcr_reg%src(nn) = c0
ovf(n)%trcr_reg%ent(nn) = c0
ovf(n)%trcr_adj%src(nn) = c0
ovf(n)%trcr_adj%ent(nn) = c0
ovf(n)%trcr_adj%prd(nn) = c0
end do
do m=1,ovf(n)%num_src
do k=1,km
ovf(n)%loc_src(m)%Utlda(k) = c0
ovf(n)%loc_src(m)%Vtlda(k) = c0
end do
ovf(n)%loc_src(m)%Uovf_nm1 = c0
ovf(n)%loc_src(m)%Uovf_n = c0
ovf(n)%loc_src(m)%Uovf = c0
ovf(n)%loc_src(m)%Wovf = c0
end do
do m=1,ovf(n)%num_ent
do k=1,km
ovf(n)%loc_ent(m)%Utlda(k) = c0
ovf(n)%loc_ent(m)%Vtlda(k) = c0
end do
ovf(n)%loc_ent(m)%Uovf_nm1 = c0
ovf(n)%loc_ent(m)%Uovf_n = c0
ovf(n)%loc_ent(m)%Uovf = c0
ovf(n)%loc_ent(m)%Wovf = c0
end do
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m)
do k=1,km
ovf(n)%loc_prd(m,mp)%Utlda(k) = c0
ovf(n)%loc_prd(m,mp)%Vtlda(k) = c0
end do
ovf(n)%loc_prd(m,mp)%Uovf_nm1 = c0
ovf(n)%loc_prd(m,mp)%Uovf_n = c0
ovf(n)%loc_prd(m,mp)%Uovf = c0
ovf(n)%loc_prd(m,mp)%Wovf = c0
end do
end do
end do ! ovf initialization loop for all processors
else if( overflows_restart_type /= 'ccsm_startup' ) then
call ovf_read_restart
call ovf_read_broadcast
endif
!-----------------------------------------------------------------------
!EOC
end subroutine init_overflows1
!***********************************************************************
!EOP
! !IROUTINE: init_overflows2
! !INTERFACE:
subroutine init_overflows2 1,4
! !DESCRIPTION:
! This routine continues the initialization of the overflows by
! scattering KMT_G to KMT, then modifying if desired, and finally
! computing overflow masks.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
!
! scatter KMT_G to KMT if topography_opt = file
!
!-----------------------------------------------------------------------
if (registry_match('topography_opt_file')) then
if (my_task == master_task) write(stdout,'(a30,a)') &
' Reading topography from file:', trim(topography_filename)
call read_topography(topography_filename,.false.)
endif
if (.not. overflows_on ) return
!-----------------------------------------------------------------------
!
! modify KMT for overflows if desired and ccsm_startup run
! make kmt changes regardless of overflows_interactive
!
!-----------------------------------------------------------------------
call init_overflows_kmt
!-----------------------------------------------------------------------
!
! set overflow masks for regional averaging
!
!-----------------------------------------------------------------------
call init_overflows_mask
!-----------------------------------------------------------------------
!EOC
end subroutine init_overflows2
!***********************************************************************
!EOP
! !IROUTINE: init_overflows_kmt
! !INTERFACE:
subroutine init_overflows_kmt 1,5
! !DESCRIPTION:
! This routine modifies kmt as required by overflows, if on
! and interactive.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!----------------------------------------------------------------------
!
! local variables
!
!----------------------------------------------------------------------
integer (int_kind) :: &
iblock,i,j,k,m,n, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
kmterr ! error index for kmt changes
type (block) :: &
this_block ! block information for current block
!----------------------------------------------------------------------
!
! search through kmt and modify for overflows
!
!----------------------------------------------------------------------
kmterr = 0
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
do i=ib,ie
do n=1,num_ovf
do m=1,ovf(n)%num_kmt
if( ovf(n)%loc_kmt(m)%i.eq.this_block%i_glob(i).and.&
ovf(n)%loc_kmt(m)%j.eq.this_block%j_glob(j) ) then
write(stdout,100) KMT(i,j,iblock),ovf(n)%loc_kmt(m)%i, &
ovf(n)%loc_kmt(m)%j,ovf(n)%loc_kmt(m)%knew
100 format(' init_overflows_kmt: KMT = ',i5,&
' at global (i,j) = ',2(i5,1x),&
' changed to ',i5)
if( KMT(i,j,iblock) .ne. ovf(n)%loc_kmt(m)%korg ) then
kmterr = kmterr + 1
endif
KMT(i,j,iblock) = ovf(n)%loc_kmt(m)%knew
endif
end do
end do
enddo
enddo
enddo
if (kmterr > 0) then
write(stdout,200) kmterr
200 format(' init_overflows_kmt: kmt inconsistencies for ',i3,' points',/ &
' original kmt not equal to actual kmt')
call shr_sys_flush(stdout)
call exit_POP(sigAbort,'ERROR kmt inconsistency for overflows')
endif
call shr_sys_flush(stdout)
call POP_HaloUpdate(KMT, POP_haloClinic, POP_gridHorzLocCenter, &
POP_fieldKindScalar, errorCode, &
fillValue = 0_POP_i4)
!----------------------------------------------------------------------
!EOC
end subroutine init_overflows_kmt
!***********************************************************************
!EOP
! !IROUTINE: init_overflows_mask
! !INTERFACE:
subroutine init_overflows_mask 1,2
! !DESCRIPTION:
! This routine sets overflow masks for regional and adjacent averaging
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!----------------------------------------------------------------------
!
! local variables
!
!----------------------------------------------------------------------
integer (int_kind) :: &
iblock,i,j,n,m, & ! dummy loop indices
ib,ie,jb,je ! local domain index boundaries
type (block) :: &
this_block ! block information for current block
!----------------------------------------------------------------------
!
! set masks for regional averaging
!
!----------------------------------------------------------------------
do n=1,num_ovf
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
! inflow region
if( ovf(n)%reg_inf%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%reg_inf%jmax ) then
do i=ib,ie
ovf(n)%mask_reg%inf(i,j,iblock) = c0
if( ovf(n)%reg_inf%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%reg_inf%imax ) then
ovf(n)%mask_reg%inf(i,j,iblock) = c1
write(stdout,30) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
30 format(' Overflow: ',a24, &
' Inflow region mask at global (ij)=',2(i3,2x))
endif
end do
endif ! inflow region
! source region
if( ovf(n)%reg_src%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%reg_src%jmax ) then
do i=ib,ie
ovf(n)%mask_reg%src(i,j,iblock) = c0
if( ovf(n)%reg_src%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%reg_src%imax ) then
ovf(n)%mask_reg%src(i,j,iblock) = c1
write(stdout,31) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
31 format(' Overflow: ',a24, &
' Source region mask at global (ij)=',2(i3,2x))
endif
end do
endif ! source region
! source adjacent
if( ovf(n)%adj_src%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%adj_src%jmax ) then
do i=ib,ie
ovf(n)%mask_adj%src(i,j,iblock) = c0
if( ovf(n)%adj_src%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%adj_src%imax ) then
ovf(n)%mask_adj%src(i,j,iblock) = c1
write(stdout,32) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
32 format(' Overflow: ',a24, &
' Source adjacent mask at global (ij)=',2(i3,2x))
endif
end do
endif ! source adjacent
! entrainment region
if( ovf(n)%reg_ent%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%reg_ent%jmax ) then
do i=ib,ie
ovf(n)%mask_reg%ent(i,j,iblock) = c0
if( ovf(n)%reg_ent%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%reg_ent%imax ) then
ovf(n)%mask_reg%ent(i,j,iblock) = c1
write(stdout,33) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
33 format(' Overflow: ',a24, &
' Entrainment region mask at global (ij)=',2(i3,2x))
endif
end do
endif ! entrainment region
! entrainment adjacent
if( ovf(n)%adj_ent%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%adj_ent%jmax ) then
do i=ib,ie
ovf(n)%mask_adj%ent(i,j,iblock) = c0
if( ovf(n)%adj_ent%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%adj_ent%imax ) then
ovf(n)%mask_adj%ent(i,j,iblock) = c1
write(stdout,34) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
34 format(' Overflow: ',a24, &
' Entrainment adjacent mask at global (ij)=',2(i3,2x))
endif
end do
endif ! entrainment adjacent
end do ! j loop
! product adjacent
do m=1,ovf(n)%num_prd_sets
do j=jb,je
if( ovf(n)%adj_prd(m)%jmin .le. this_block%j_glob(j) .and. &
this_block%j_glob(j) .le. ovf(n)%adj_prd(m)%jmax ) then
do i=ib,ie
ovf(n)%mask_adj%prd(i,j,iblock,m) = c0
if( ovf(n)%adj_prd(m)%imin .le. this_block%i_glob(i) .and. &
this_block%i_glob(i) .le. ovf(n)%adj_prd(m)%imax ) then
ovf(n)%mask_adj%prd(i,j,iblock,m) = c1
write(stdout,35) ovf(n)%name,this_block%i_glob(i), &
this_block%j_glob(j)
35 format(' Overflow: ',a24, &
' Product adjacent mask at global (ij)=',2(i3,2x))
endif
end do
endif ! product adjacent
end do
end do
end do
end do
call shr_sys_flush(stdout)
!----------------------------------------------------------------------
!EOC
end subroutine init_overflows_mask
!***********************************************************************
!EOP
! !IROUTINE: init_overflows3
! !INTERFACE:
subroutine init_overflows3 1,1
! !DESCRIPTION:
! This routine completes the initialization of the overflows by
! modifying the 9pt coefficients for the barotropic solution
! as required for each overflow grid box
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
!
! modify 9pt coefficients for barotropic solver
!
!-----------------------------------------------------------------------
if( overflows_on .and. overflows_interactive ) then
call ovf_solvers_9pt
endif
!-----------------------------------------------------------------------
!EOC
end subroutine init_overflows3
!***********************************************************************
!EOP
! !IROUTINE: init_overflows4
! !INTERFACE:
subroutine init_overflows4 1,2
! !DESCRIPTION:
! This routine creates the overflow output diagnostics filename, now
! that the initial model run time is known.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
character (char_len) :: &
string
save
!-----------------------------------------------------------------------
! if overflows off, exit
!-----------------------------------------------------------------------
if (.not. overflows_on ) return
!-----------------------------------------------------------------------
! set up output file and unit for overflow diagnostics
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! define ccsm overflow diagnostics output filename
!-----------------------------------------------------------------------
if (lccsm) then
call ccsm_date_stamp (ccsm_diag_date, 'ymds')
string = overflows_diag_outfile
overflows_diag_outfile = trim(string)/&
&/'.'/&
&/trim(ccsm_diag_date)
else
!-----------------------------------------------------------------------
! append runid, initial date to output file names
! concatenation operator must be split across lines to avoid problems
! with preprocessors
!-----------------------------------------------------------------------
if (date_separator == ' ') then
cdate(1:4) = cyear
cdate(5:6) = cmonth
cdate(7:8) = cday
cdate(9:10)= ' '
else
cdate(1:4) = cyear
cdate(5:5) = date_separator
cdate(6:7) = cmonth
cdate(8:8) = date_separator
cdate(9:10) = cday
endif
outfile_tmp = char_blank
outfile_tmp = trim(overflows_diag_outfile)/&
&/'.'/&
&/trim(runid)/&
&/'.'/&
&/trim(cdate)
overflows_diag_outfile = trim(outfile_tmp)
endif ! lccsm
call get_unit(ovf_diag_unit)
if (my_task == master_task) then
open(ovf_diag_unit, file=overflows_diag_outfile, status='unknown')
write(ovf_diag_unit,*)' '
close(ovf_diag_unit)
write(stdout,'(a,a)') &
'Overflow diagnostics written to file: ', trim(overflows_diag_outfile)
endif
!-----------------------------------------------------------------------
!EOC
end subroutine init_overflows4
!***********************************************************************
!EOP
! !IROUTINE: init_overflows5
! !INTERFACE:
subroutine init_overflows5 1,1
! !DESCRIPTION:
! This routine computes regional aveages required at restart
! for overflow regions, using all available tracers, and also
! computes regional product values based on source and entrainment.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
integer (int_kind) :: &
n ,& ! index of overflow
nn ! ovf tracer index
real (r8) :: &
phi ! entrainment parameter from actual ratio Me/Mp
!-----------------------------------------------------------------------
!
! compute regional averages.
!
!-----------------------------------------------------------------------
if( overflows_on .and. overflows_interactive ) then
call ovf_reg_avgs(oldtime)
! evaluate regional product values based on src,ent averages just computed
do n=1,num_ovf
phi = ovf(n)%phi
do nn=1,nt
ovf(n)%trcr_reg%prd(nn) = ovf(n)%trcr_reg%src(nn) * (c1 - phi) &
+ ovf(n)%trcr_reg%ent(nn) * phi
end do
enddo
endif
!-----------------------------------------------------------------------
!EOC
end subroutine init_overflows5
!***********************************************************************
!EOP
! !IROUTINE: ovf_write_restart
! !INTERFACE:
subroutine ovf_write_restart 1,9
! !DESCRIPTION:
! This routine writes the overflow restart file using
! selected data from overflow array.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
integer (int_kind) :: &
mu, &! unit for ovf restart file
ovf_error, &! error flag
n, &! ovf loop index
m, &! sub-ovf loop index
nn, &! tracer loop index
mp ! sub-ovf sub-loop index
character (char_len) :: &
write_restart_filename, &! modified file name for restart file
ovf_restart_pointer_file, &! overflows rpointer filename
file_suffix, &! suffix to append to root filename
char_temp ! temporary character string
character (10) :: &! for input year,month,day
cdate
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_write_restart called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! if overflows off, exit
!-----------------------------------------------------------------------
if( .not. overflows_on ) return
cdate(1:4) = cyear
cdate(5:6) = cmonth
cdate(7:8) = cday
cdate(9:10)= ' '
ovf_error = 0
call get_unit(mu)
write_restart_filename = char_blank
file_suffix = char_blank
if (registry_match('lccsm')) then
call ccsm_date_stamp(char_temp, 'ymds')
file_suffix = trim(char_temp)
!*** must split concatenation operator to avoid preprocessor mangling
write_restart_filename = trim(overflows_restfile)/&
&/'.'/&
&/trim(file_suffix)
else
write_restart_filename = trim(overflows_restfile)
endif
!-----------------------------------------------------------------------
! master task section
!-----------------------------------------------------------------------
if (my_task == master_task) then
open(mu, file=write_restart_filename, status='unknown',iostat=ovf_error)
write(stdout,987) mu,write_restart_filename
987 format(' ovf_write_restart unit (mu) = ',i5,' file name = ',a64)
write(stdout,99) cdate
99 format(' ovf write restart cdate yyyymmdd = ',a10)
call shr_sys_flush(stdout)
write(mu,100) cdate,num_ovf
100 format(30x,' ! Overflow Restart File for yyyymmdd =',a10/ &
2x,i10,20x,'! number of overflows')
do n=1,num_ovf
write(mu,101) ovf(n)%name
101 format(2x,a26,' ! name of overflow')
! ovf parameters
write(mu,102) ovf(n)%ovf_params%lat
102 format(2x,1PE27.18,' ! latitude in degrees')
write(mu,103) ovf(n)%ovf_params%width
103 format(2x,1PE27.18,' ! channel width in meters')
write(mu,105) ovf(n)%ovf_params%source_thick
105 format(2x,1PE27.18,' ! source thickness in meters')
write(mu,106) ovf(n)%ovf_params%distnc_str_ssb
106 format(2x,1PE27.18,' ! strait to shelf-slope break in meters')
write(mu,107) ovf(n)%ovf_params%bottom_slope
107 format(2x,1PE27.18,' ! bottom slope dy/dx ')
write(mu,108) ovf(n)%ovf_params%bottom_drag
108 format(2x,1PE27.18,' ! bottom drag coefficient')
! kmt changes, if any
write(mu,1090) ovf(n)%num_kmt
1090 format(2x,i10,20x,'! number of kmt changes')
do m=1,ovf(n)%num_kmt
write(mu,1091) ovf(n)%loc_kmt(m)%i
1091 format(2x,i10,20x,'! i grid box index for kmt change')
write(mu,1092) ovf(n)%loc_kmt(m)%j
1092 format(2x,i10,20x,'! j grid box index for kmt change')
write(mu,1093) ovf(n)%loc_kmt(m)%korg
1093 format(2x,i10,20x,'! korg original grid box k index')
write(mu,1094) ovf(n)%loc_kmt(m)%knew
1094 format(2x,i10,20x,'! knew new grid box k index')
end do
! regional boundaries
! inflow
write(mu,110) ovf(n)%reg_inf%imin
110 format(2x,i10,20x,'! inflow region imin')
write(mu,111) ovf(n)%reg_inf%imax
111 format(2x,i10,20x,'! inflow region imax')
write(mu,112) ovf(n)%reg_inf%jmin
112 format(2x,i10,20x,'! inflow region jmin')
write(mu,113) ovf(n)%reg_inf%jmax
113 format(2x,i10,20x,'! inflow region jmax')
write(mu,114) ovf(n)%reg_inf%kmin
114 format(2x,i10,20x,'! inflow region kmin')
write(mu,115) ovf(n)%reg_inf%kmax
115 format(2x,i10,20x,'! inflow region kmax')
! source
write(mu,116) ovf(n)%reg_src%imin
116 format(2x,i10,20x,'! source region imin')
write(mu,117) ovf(n)%reg_src%imax
117 format(2x,i10,20x,'! source region imax')
write(mu,118) ovf(n)%reg_src%jmin
118 format(2x,i10,20x,'! source region jmin')
write(mu,119) ovf(n)%reg_src%jmax
119 format(2x,i10,20x,'! source region jmax')
write(mu,120) ovf(n)%reg_src%kmin
120 format(2x,i10,20x,'! source region kmin')
write(mu,121) ovf(n)%reg_src%kmax
121 format(2x,i10,20x,'! source region kmax')
! entrainment
write(mu,122) ovf(n)%reg_ent%imin
122 format(2x,i10,20x,'! entrainment region imin')
write(mu,123) ovf(n)%reg_ent%imax
123 format(2x,i10,20x,'! entrainment region imax')
write(mu,124) ovf(n)%reg_ent%jmin
124 format(2x,i10,20x,'! entrainment region jmin')
write(mu,125) ovf(n)%reg_ent%jmax
125 format(2x,i10,20x,'! entrainment region jmax')
write(mu,126) ovf(n)%reg_ent%kmin
126 format(2x,i10,20x,'! entrainment region kmin')
write(mu,127) ovf(n)%reg_ent%kmax
127 format(2x,i10,20x,'! entrainment region kmax')
! src locs and orientation
write(mu,128) ovf(n)%num_src
128 format(2x,i10,20x,'! number of source grid boxes')
do m=1,ovf(n)%num_src
write(mu,129) ovf(n)%loc_src(m)%i
129 format(2x,i10,20x,'! source box i')
write(mu,130) ovf(n)%loc_src(m)%j
130 format(2x,i10,20x,'! source box j')
write(mu,131) ovf(n)%loc_src(m)%i_adv
131 format(2x,i10,20x,'! source box i_adv')
write(mu,132) ovf(n)%loc_src(m)%j_adv
132 format(2x,i10,20x,'! source box j_adv')
write(mu,133) ovf(n)%loc_src(m)%i_u
133 format(2x,i10,20x,'! source box i_u')
write(mu,134) ovf(n)%loc_src(m)%j_u
134 format(2x,i10,20x,'! source box j_u')
write(mu,135) ovf(n)%loc_src(m)%k
135 format(2x,i10,20x,'! source box k')
write(mu,136) ovf(n)%loc_src(m)%orient
136 format(2x,i10,20x,'! source box orient')
end do
! ent locs and orientation
write(mu,137) ovf(n)%num_ent
137 format(2x,i10,20x,'! number of entrainment grid boxes')
do m=1,ovf(n)%num_ent
write(mu,138) ovf(n)%loc_ent(m)%i
138 format(2x,i10,20x,'! entrainment box i')
write(mu,139) ovf(n)%loc_ent(m)%j
139 format(2x,i10,20x,'! entrainment box j')
write(mu,140) ovf(n)%loc_ent(m)%i_adv
140 format(2x,i10,20x,'! entrainment box i_adv')
write(mu,141) ovf(n)%loc_ent(m)%j_adv
141 format(2x,i10,20x,'! entrainment box j_adv')
write(mu,142) ovf(n)%loc_ent(m)%i_u
142 format(2x,i10,20x,'! entrainment box i_u')
write(mu,143) ovf(n)%loc_ent(m)%j_u
143 format(2x,i10,20x,'! entrainment box j_u')
write(mu,144) ovf(n)%loc_ent(m)%k
144 format(2x,i10,20x,'! entrainment box k')
write(mu,145) ovf(n)%loc_ent(m)%orient
145 format(2x,i10,20x,'! entrainment box orient')
end do
! prd locs and orientation
write(mu,146) ovf(n)%num_prd_sets
146 format(2x,i10,20x,'! number of product sets')
do m=1,ovf(n)%num_prd_sets
write(mu,147) ovf(n)%num_prd(m)
147 format(2x,i10,20x, &
'! number of product grid boxes for this set')
do mp=1,ovf(n)%num_prd(m)
write(mu,148) ovf(n)%loc_prd(m,mp)%i
148 format(2x,i10,20x,'! product box i')
write(mu,149) ovf(n)%loc_prd(m,mp)%j
149 format(2x,i10,20x,'! product box j')
write(mu,150) ovf(n)%loc_prd(m,mp)%i_adv
150 format(2x,i10,20x,'! product box i_adv')
write(mu,151) ovf(n)%loc_prd(m,mp)%j_adv
151 format(2x,i10,20x,'! product box j_adv')
write(mu,152) ovf(n)%loc_prd(m,mp)%i_u
152 format(2x,i10,20x,'! product box i_u')
write(mu,153) ovf(n)%loc_prd(m,mp)%j_u
153 format(2x,i10,20x,'! product box j_u')
write(mu,154) ovf(n)%loc_prd(m,mp)%k
154 format(2x,i10,20x,'! product box k')
write(mu,155) ovf(n)%loc_prd(m,mp)%orient
155 format(2x,i10,20x,'! product box orient')
end do
end do
! adjacent boundaries
! src
write(mu,156) ovf(n)%adj_src%imin
156 format(2x,i10,20x,'! source adjacent imin')
write(mu,157) ovf(n)%adj_src%imax
157 format(2x,i10,20x,'! source adjacent imax')
write(mu,158) ovf(n)%adj_src%jmin
158 format(2x,i10,20x,'! source adjacent jmin')
write(mu,159) ovf(n)%adj_src%jmax
159 format(2x,i10,20x,'! source adjacent jmax')
write(mu,160) ovf(n)%adj_src%kmin
160 format(2x,i10,20x,'! source adjacent kmin')
write(mu,161) ovf(n)%adj_src%kmax
161 format(2x,i10,20x,'! source adjacent kmax')
!ent
write(mu,162) ovf(n)%adj_ent%imin
162 format(2x,i10,20x,'! entrainment adjacent imin')
write(mu,163) ovf(n)%adj_ent%imax
163 format(2x,i10,20x,'! entrainment adjacent imax')
write(mu,164) ovf(n)%adj_ent%jmin
164 format(2x,i10,20x,'! entrainment adjacent jmin')
write(mu,165) ovf(n)%adj_ent%jmax
165 format(2x,i10,20x,'! entrainment adjacent jmax')
write(mu,166) ovf(n)%adj_ent%kmin
166 format(2x,i10,20x,'! entrainment adjacent kmin')
write(mu,167) ovf(n)%adj_ent%kmax
167 format(2x,i10,20x,'! entrainment adjacent kmax')
!prd
do m=1,ovf(n)%num_prd_sets
write(mu,168) ovf(n)%adj_prd(m)%imin
168 format(2x,i10,20x,'! product adjacent imin')
write(mu,169) ovf(n)%adj_prd(m)%imax
169 format(2x,i10,20x,'! product adjacent imax')
write(mu,170) ovf(n)%adj_prd(m)%jmin
170 format(2x,i10,20x,'! product adjacent jmin')
write(mu,171) ovf(n)%adj_prd(m)%jmax
171 format(2x,i10,20x,'! product adjacent jmax')
write(mu,172) ovf(n)%adj_prd(m)%kmin
172 format(2x,i10,20x,'! product adjacent kmin')
write(mu,173) ovf(n)%adj_prd(m)%kmax
173 format(2x,i10,20x,'! product adjacent kmax')
end do
! transports
write(mu,174) ovf(n)%Ms
174 format(2x,1PE27.18,' ! source volume n+1 transport cm3/sec')
write(mu,175) ovf(n)%Ms_n
175 format(2x,1PE27.18,' ! source volume n transport cm3/sec')
write(mu,176) ovf(n)%Ms_nm1
176 format(2x,1PE27.18,' ! source volume n-1 transport cm3/sec')
write(mu,177) ovf(n)%Me
177 format(2x,1PE27.18,' ! entrainment volume n+1 transport cm3/sec')
write(mu,178) ovf(n)%Me_n
178 format(2x,1PE27.18,' ! entrainment volume n transport cm3/sec')
write(mu,179) ovf(n)%Me_nm1
179 format(2x,1PE27.18,' ! entrainment volume n-1 transport cm3/sec')
write(mu,180) ovf(n)%phi
180 format(2x,1PE27.18,' ! phi parameter')
write(mu,181) ovf(n)%Mp
181 format(2x,1PE27.18,' ! product volume n+1 transport cm3/sec')
write(mu,182) ovf(n)%Mp_n
182 format(2x,1PE27.18,' ! product volume n transport cm3/sec')
write(mu,183) ovf(n)%Mp_nm1
183 format(2x,1PE27.18,' ! product volume n-1 transport cm3/sec')
write(mu,184) ovf(n)%Tp
184 format(2x,1PE27.18,' ! product temperature C')
write(mu,185) ovf(n)%Sp
185 format(2x,1PE27.18,' ! product salinity')
write(mu,186) ovf(n)%prd_set_n
write(mu,186) ovf(n)%prd_set
186 format(2x,i10,20x,'! product set index (first is previous time step)')
end do ! ovf loop
close(mu)
endif ! my_task == master_task
call release_unit(mu)
!-----------------------------------------------------------------------
!
! if pointer files are used, write filename to pointer file
!
!-----------------------------------------------------------------------
if (luse_pointer_files) then
call get_unit(mu)
if (my_task == master_task) then
ovf_restart_pointer_file = trim(pointer_filename)/&
&/'.ovf'
open(mu, file=ovf_restart_pointer_file, form='formatted', status='unknown')
write(mu,'(a)') trim(write_restart_filename)
close(mu)
write(stdout,blank_fmt)
write(stdout,*) ' overflow restart pointer file written: ',trim(ovf_restart_pointer_file)
call POP_IOUnitsFlush(POP_stdout)
endif
call release_unit(mu)
endif
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_write_restart
!***********************************************************************
!EOP
! !IROUTINE: ovf_read_restart
! !INTERFACE:
subroutine ovf_read_restart 1,8
! !DESCRIPTION:
! This routine reads the overflow restart file for
! selected data from overflow array.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
integer (POP_i4) :: &
mu, &! unit for ovf restart file
ovf_error, &! error flag
n, &! ovf loop index
m, &! sub-ovf loop index
nn, &! tracer loop index
mp, &! sub-ovf sub-loop index
ntrcr, &! number of tracers on read
cindx,cindx2 ! indices into restart pointer character string
character (POP_charLength) :: &
restart_pointer_file, &! file name for restart pointer file
read_overflows_restfile, &! local restart filename
cdate_label ! for input year,month,day
logical (POP_logical), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_read_restart called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! if overflows off, exit
!-----------------------------------------------------------------------
if( .not. overflows_on ) return
ovf_error = 0
!-----------------------------------------------------------------------
!
! if pointer files are used, overflows pointer file must be read to get
! actual filenames - skip this for ccsm_branch initialization
!
! otherwise use input filename
!-----------------------------------------------------------------------
errorCode = POP_Success
read_overflows_restfile = char_blank
restart_pointer_file = char_blank
if (luse_pointer_files) then
call get_unit(mu)
if (my_task == master_task) then
restart_pointer_file = pointer_filename
cindx = len_trim(pointer_filename) + 1
cindx2= cindx + 3
restart_pointer_file(cindx:cindx2) = '.ovf'
write(stdout,*) 'Reading overflow pointer file: ', trim(restart_pointer_file)
call POP_IOUnitsFlush(POP_stdout)
open(mu, file=trim(restart_pointer_file), form='formatted', status='old')
read(mu,'(a)') read_overflows_restfile
close(mu)
endif
call release_unit(mu)
call broadcast_scalar(read_overflows_restfile, master_task)
else
! use overflows_restfile from namelist
read_overflows_restfile = trim(overflows_restfile)
endif
!-----------------------------------------------------------------------
! read overflows restart file
!-----------------------------------------------------------------------
call get_unit(mu)
if (my_task == master_task) then
open(mu, file=read_overflows_restfile, status='unknown',iostat=ovf_error)
write(stdout,987) mu,read_overflows_restfile
987 format(' ovf_read_restart unit (mu) = ',i5,' file name = ',a)
read(mu,99) cdate_label,num_ovf
99 format(a80/2x,i10)
write(stdout,100) cdate_label,num_ovf
100 format(' ovf read restart label =',/a80/ &
' number of overflows = ',i5)
call shr_sys_flush(stdout)
do n=1,num_ovf
read(mu,101) ovf(n)%name
101 format(2x,a26)
! ovf parameters
read(mu,102) ovf(n)%ovf_params%lat
102 format(2x,1PE27.18)
read(mu,103) ovf(n)%ovf_params%width
103 format(2x,1PE27.18)
read(mu,105) ovf(n)%ovf_params%source_thick
105 format(2x,1PE27.18)
read(mu,106) ovf(n)%ovf_params%distnc_str_ssb
106 format(2x,1PE27.18)
read(mu,107) ovf(n)%ovf_params%bottom_slope
107 format(2x,1PE27.18)
read(mu,108) ovf(n)%ovf_params%bottom_drag
108 format(2x,1PE27.18)
! kmt changes, if any
read(mu,1090) ovf(n)%num_kmt
1090 format(2x,i10,20x,'! number of kmt changes')
do m=1,ovf(n)%num_kmt
read(mu,1091) ovf(n)%loc_kmt(m)%i
1091 format(2x,i10,20x,'! i grid box index for kmt change')
read(mu,1092) ovf(n)%loc_kmt(m)%j
1092 format(2x,i10,20x,'! j grid box index for kmt change')
read(mu,1093) ovf(n)%loc_kmt(m)%korg
1093 format(2x,i10,20x,'! korg original grid box k index')
read(mu,1094) ovf(n)%loc_kmt(m)%knew
1094 format(2x,i10,20x,'! knew new grid box k index')
end do
! regional boundaries
! inflow
read(mu,110) ovf(n)%reg_inf%imin
110 format(2x,i10,20x)
read(mu,111) ovf(n)%reg_inf%imax
111 format(2x,i10,20x)
read(mu,112) ovf(n)%reg_inf%jmin
112 format(2x,i10,20x)
read(mu,113) ovf(n)%reg_inf%jmax
113 format(2x,i10,20x)
read(mu,114) ovf(n)%reg_inf%kmin
114 format(2x,i10,20x)
read(mu,115) ovf(n)%reg_inf%kmax
115 format(2x,i10,20x)
! source
read(mu,116) ovf(n)%reg_src%imin
116 format(2x,i10,20x)
read(mu,117) ovf(n)%reg_src%imax
117 format(2x,i10,20x)
read(mu,118) ovf(n)%reg_src%jmin
118 format(2x,i10,20x)
read(mu,119) ovf(n)%reg_src%jmax
119 format(2x,i10,20x)
read(mu,120) ovf(n)%reg_src%kmin
120 format(2x,i10,20x)
read(mu,121) ovf(n)%reg_src%kmax
121 format(2x,i10,20x)
! entrainment
read(mu,122) ovf(n)%reg_ent%imin
122 format(2x,i10,20x)
read(mu,123) ovf(n)%reg_ent%imax
123 format(2x,i10,20x)
read(mu,124) ovf(n)%reg_ent%jmin
124 format(2x,i10,20x)
read(mu,125) ovf(n)%reg_ent%jmax
125 format(2x,i10,20x)
read(mu,126) ovf(n)%reg_ent%kmin
126 format(2x,i10,20x)
read(mu,127) ovf(n)%reg_ent%kmax
127 format(2x,i10,20x)
! src locs and orientation
read(mu,128) ovf(n)%num_src
128 format(2x,i10,20x)
do m=1,ovf(n)%num_src
read(mu,129) ovf(n)%loc_src(m)%i
129 format(2x,i10,20x)
read(mu,130) ovf(n)%loc_src(m)%j
130 format(2x,i10,20x)
read(mu,131) ovf(n)%loc_src(m)%i_adv
131 format(2x,i10,20x)
read(mu,132) ovf(n)%loc_src(m)%j_adv
132 format(2x,i10,20x)
read(mu,133) ovf(n)%loc_src(m)%i_u
133 format(2x,i10,20x)
read(mu,134) ovf(n)%loc_src(m)%j_u
134 format(2x,i10,20x)
read(mu,135) ovf(n)%loc_src(m)%k
135 format(2x,i10,20x)
read(mu,136) ovf(n)%loc_src(m)%orient
136 format(2x,i10,20x)
end do
! ent locs and orientation
read(mu,137) ovf(n)%num_ent
137 format(2x,i10,20x)
do m=1,ovf(n)%num_ent
read(mu,138) ovf(n)%loc_ent(m)%i
138 format(2x,i10,20x)
read(mu,139) ovf(n)%loc_ent(m)%j
139 format(2x,i10,20x)
read(mu,140) ovf(n)%loc_ent(m)%i_adv
140 format(2x,i10,20x)
read(mu,141) ovf(n)%loc_ent(m)%j_adv
141 format(2x,i10,20x)
read(mu,142) ovf(n)%loc_ent(m)%i_u
142 format(2x,i10,20x)
read(mu,143) ovf(n)%loc_ent(m)%j_u
143 format(2x,i10,20x)
read(mu,144) ovf(n)%loc_ent(m)%k
144 format(2x,i10,20x)
read(mu,145) ovf(n)%loc_ent(m)%orient
145 format(2x,i10,20x)
end do
! prd locs and orientation
read(mu,146) ovf(n)%num_prd_sets
146 format(2x,i10,20x)
do m=1,ovf(n)%num_prd_sets
read(mu,147) ovf(n)%num_prd(m)
147 format(2x,i10,20x)
do mp=1,ovf(n)%num_prd(m)
read(mu,148) ovf(n)%loc_prd(m,mp)%i
148 format(2x,i10,20x)
read(mu,149) ovf(n)%loc_prd(m,mp)%j
149 format(2x,i10,20x)
read(mu,150) ovf(n)%loc_prd(m,mp)%i_adv
150 format(2x,i10,20x)
read(mu,151) ovf(n)%loc_prd(m,mp)%j_adv
151 format(2x,i10,20x)
read(mu,152) ovf(n)%loc_prd(m,mp)%i_u
152 format(2x,i10,20x)
read(mu,153) ovf(n)%loc_prd(m,mp)%j_u
153 format(2x,i10,20x)
read(mu,154) ovf(n)%loc_prd(m,mp)%k
154 format(2x,i10,20x)
read(mu,155) ovf(n)%loc_prd(m,mp)%orient
155 format(2x,i10,20x)
end do
end do
! adjacent boundaries
! src
read(mu,156) ovf(n)%adj_src%imin
156 format(2x,i10,20x)
read(mu,157) ovf(n)%adj_src%imax
157 format(2x,i10,20x)
read(mu,158) ovf(n)%adj_src%jmin
158 format(2x,i10,20x)
read(mu,159) ovf(n)%adj_src%jmax
159 format(2x,i10,20x)
read(mu,160) ovf(n)%adj_src%kmin
160 format(2x,i10,20x)
read(mu,161) ovf(n)%adj_src%kmax
161 format(2x,i10,20x)
!ent
read(mu,162) ovf(n)%adj_ent%imin
162 format(2x,i10,20x)
read(mu,163) ovf(n)%adj_ent%imax
163 format(2x,i10,20x)
read(mu,164) ovf(n)%adj_ent%jmin
164 format(2x,i10,20x)
read(mu,165) ovf(n)%adj_ent%jmax
165 format(2x,i10,20x)
read(mu,166) ovf(n)%adj_ent%kmin
166 format(2x,i10,20x)
read(mu,167) ovf(n)%adj_ent%kmax
167 format(2x,i10,20x)
!prd
do m=1,ovf(n)%num_prd_sets
read(mu,168) ovf(n)%adj_prd(m)%imin
168 format(2x,i10,20x)
read(mu,169) ovf(n)%adj_prd(m)%imax
169 format(2x,i10,20x)
read(mu,170) ovf(n)%adj_prd(m)%jmin
170 format(2x,i10,20x)
read(mu,171) ovf(n)%adj_prd(m)%jmax
171 format(2x,i10,20x)
read(mu,172) ovf(n)%adj_prd(m)%kmin
172 format(2x,i10,20x)
read(mu,173) ovf(n)%adj_prd(m)%kmax
173 format(2x,i10,20x)
end do
! transports
read(mu,174) ovf(n)%Ms
174 format(2x,1PE27.18)
read(mu,175) ovf(n)%Ms_n
175 format(2x,1PE27.18)
read(mu,176) ovf(n)%Ms_nm1
176 format(2x,1PE27.18)
read(mu,177) ovf(n)%Me
177 format(2x,1PE27.18)
read(mu,178) ovf(n)%Me_n
178 format(2x,1PE27.18)
read(mu,179) ovf(n)%Me_nm1
179 format(2x,1PE27.18)
read(mu,180) ovf(n)%phi
180 format(2x,1PE27.18)
read(mu,181) ovf(n)%Mp
181 format(2x,1PE27.18)
read(mu,182) ovf(n)%Mp_n
182 format(2x,1PE27.18)
read(mu,183) ovf(n)%Mp_nm1
183 format(2x,1PE27.18)
read(mu,184) ovf(n)%Tp
184 format(2x,1PE27.18)
read(mu,185) ovf(n)%Sp
185 format(2x,1PE27.18)
read(mu,186) ovf(n)%prd_set_n
read(mu,186) ovf(n)%prd_set
186 format(2x,i10,20x)
end do ! ovf loop
close(mu)
endif ! my_task == master_task
call release_unit(mu)
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_read_restart
!***********************************************************************
!EOP
! !IROUTINE: ovf_read_broadcast
! !INTERFACE:
subroutine ovf_read_broadcast 1,98
! !DESCRIPTION:
! This routine broadcasts selected data in ovf array from the
! master_task to all processors.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
integer (int_kind) :: &
n, &! ovf loop index
m, &! sub-ovf loop index
nn, &! tracer loop index
mp, &! sub-ovf sub-loop index
k ! vertical loop index
!-----------------------------------------------------------------------
! if overflows off, exit
!-----------------------------------------------------------------------
if( .not. overflows_on ) return
!-----------------------------------------------------------------------
! broadcast overflows info to all processors
!-----------------------------------------------------------------------
call broadcast_scalar(num_ovf, master_task)
do n=1,num_ovf
call broadcast_scalar(ovf(n)%name, master_task)
! ovf data
call broadcast_scalar(ovf(n)%ovf_params%lat, master_task)
call broadcast_scalar(ovf(n)%ovf_params%width, master_task)
call broadcast_scalar(ovf(n)%ovf_params%source_thick, master_task)
call broadcast_scalar(ovf(n)%ovf_params%distnc_str_ssb, master_task)
call broadcast_scalar(ovf(n)%ovf_params%bottom_slope, master_task)
call broadcast_scalar(ovf(n)%ovf_params%bottom_drag, master_task)
! kmt changes, if any
call broadcast_scalar(ovf(n)%num_kmt, master_task)
do m=1,ovf(n)%num_kmt
call broadcast_scalar(ovf(n)%loc_kmt(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%korg, master_task)
call broadcast_scalar(ovf(n)%loc_kmt(m)%knew, master_task)
end do
! regional boundaries
! inflow
call broadcast_scalar(ovf(n)%reg_inf%imin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%imax, master_task)
call broadcast_scalar(ovf(n)%reg_inf%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_inf%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_inf%kmax, master_task)
! source
call broadcast_scalar(ovf(n)%reg_src%imin, master_task)
call broadcast_scalar(ovf(n)%reg_src%imax, master_task)
call broadcast_scalar(ovf(n)%reg_src%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_src%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_src%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_src%kmax, master_task)
! entrainment
call broadcast_scalar(ovf(n)%reg_ent%imin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%imax, master_task)
call broadcast_scalar(ovf(n)%reg_ent%jmin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%jmax, master_task)
call broadcast_scalar(ovf(n)%reg_ent%kmin, master_task)
call broadcast_scalar(ovf(n)%reg_ent%kmax, master_task)
! src locs and orientation
call broadcast_scalar(ovf(n)%num_src, master_task)
do m=1,ovf(n)%num_src
call broadcast_scalar(ovf(n)%loc_src(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%k, master_task)
call broadcast_scalar(ovf(n)%loc_src(m)%orient, master_task)
end do
! ent locs and orientation
call broadcast_scalar(ovf(n)%num_ent, master_task)
do m=1,ovf(n)%num_ent
call broadcast_scalar(ovf(n)%loc_ent(m)%i, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%k, master_task)
call broadcast_scalar(ovf(n)%loc_ent(m)%orient, master_task)
end do
! prd locs and orientation
call broadcast_scalar(ovf(n)%num_prd_sets, master_task)
do m=1,ovf(n)%num_prd_sets
call broadcast_scalar(ovf(n)%num_prd(m), master_task)
do mp=1,ovf(n)%num_prd(m)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i_adv, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j_adv, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%i_u, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%j_u, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%k, master_task)
call broadcast_scalar(ovf(n)%loc_prd(m,mp)%orient, master_task)
end do
end do
! adjacent boundaries
call broadcast_scalar(ovf(n)%adj_src%imin, master_task)
call broadcast_scalar(ovf(n)%adj_src%imax, master_task)
call broadcast_scalar(ovf(n)%adj_src%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_src%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_src%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_src%kmax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%imin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%imax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_ent%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_ent%kmax, master_task)
do m=1,ovf(n)%num_prd_sets
call broadcast_scalar(ovf(n)%adj_prd(m)%imin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%imax, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%jmin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%jmax, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%kmin, master_task)
call broadcast_scalar(ovf(n)%adj_prd(m)%kmax, master_task)
end do
! transports
call broadcast_scalar(ovf(n)%Ms, master_task)
call broadcast_scalar(ovf(n)%Ms_n, master_task)
call broadcast_scalar(ovf(n)%Ms_nm1, master_task)
call broadcast_scalar(ovf(n)%Me, master_task)
call broadcast_scalar(ovf(n)%Me_n, master_task)
call broadcast_scalar(ovf(n)%Me_nm1, master_task)
call broadcast_scalar(ovf(n)%phi, master_task)
call broadcast_scalar(ovf(n)%Mp, master_task)
call broadcast_scalar(ovf(n)%Mp_n, master_task)
call broadcast_scalar(ovf(n)%Mp_nm1, master_task)
call broadcast_scalar(ovf(n)%Tp, master_task)
call broadcast_scalar(ovf(n)%Sp, master_task)
call broadcast_scalar(ovf(n)%prd_set_n, master_task)
call broadcast_scalar(ovf(n)%prd_set, master_task)
do nn=1,nt
call broadcast_scalar(ovf(n)%trcr_reg%inf(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_reg%src(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_reg%ent(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_reg%prd(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_adj%src(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_adj%ent(nn), master_task)
call broadcast_scalar(ovf(n)%trcr_adj%prd(nn), master_task)
end do
end do ! ovf broadcast loop for all processors
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_read_broadcast
!***********************************************************************
!EOP
! !IROUTINE: ovf_advt
! !INTERFACE:
subroutine ovf_advt(k,TRACER_E,TRACER_N,ntr,this_block, & 4,1
CE,CW,CN,CS)
! !DESCRIPTION:
! Modify tracer grid interface value for advection for
! overflow points; orientation determines if E or N is modified
! !REVISION HISTORY:
! same as module
!
! ovf t-grid box ij showing advection grid boxes
! (i_adv,j_adv) set by orientation
! ij+1
!
! ____2_____
! y ^ | |
! | | |
! | i-1j 3| ij |1 i+1j
! +-----> | |
! x |__________|
! 4
!
! ij-1
!
! Note! Orientations are relative to overflow ij, while
! the advection boxes are offset as in the diagram above.
! Thus, the indices for TRACER_E and TRACER_N are reversed.
! For instance, orient=1 src, the advection box is i+1,j
! above, but when ij is that box (see below), then it is the
! western TRACER_E, or i-1j, that is overwritten. This is
! reversed from the center ij, because of the offset in the
! advection boxes relative to box ij.
!
! Note! ij loops include ghost points incase advection
! scheme requires them.
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind), intent(in) :: &
k ! vertical index
real (r8), dimension(nx_block,ny_block), intent(inout) :: &
TRACER_E, & ! east gridbox interface tracer at level k
TRACER_N ! north gridbox interface tracer at level k
integer (int_kind), intent(in) :: &
ntr ! tracer index
type (block), intent(in) :: &
this_block ! block information for this block
real (r8), dimension(nx_block,ny_block), intent(in) :: &
CN,CS,CE,CW ! stencil weights based on flux velocities
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
n,m,mp,i,j, & ! dummy loop indices
ksrc,kent,kprd ! overflow level indices
integer (int_kind) :: &
iblock ! local block address for this block
logical (log_kind), parameter :: prnt = .false.
! turn off print 3 Nov 2008
! if( prnt .and. my_task == master_task ) then
! write(stdout,*) 'ovf_advt called '
! call shr_sys_flush(stdout)
! endif
iblock = this_block%local_id
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
if( k == ksrc ) then
do j=1,ny_block
if( ovf(n)%loc_src(m)%j_adv .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_src(m)%i_adv .eq. this_block%i_glob(i) ) then
if( prnt ) then
write(stdout,5) nsteps_total,n,ovf(n)%loc_src(m)%i_adv, &
ovf(n)%loc_src(m)%j_adv,ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1)
5 format(' In ovf_advt src ',i5,1x,6(i3,1x),4(1pe15.8,1x))
endif ! print
if( i > 1 ) then
if( ovf(n)%loc_src(m)%orient .eq. 1 ) then
TRACER_E(i-1,j) = ovf(n)%trcr_reg%src(ntr)
endif
endif
if( j > 1 ) then
if( ovf(n)%loc_src(m)%orient .eq. 2 ) then
TRACER_N(i,j-1) = ovf(n)%trcr_reg%src(ntr)
endif
endif
if( ovf(n)%loc_src(m)%orient .eq. 3 ) then
TRACER_E(i,j) = ovf(n)%trcr_reg%src(ntr)
endif
if( ovf(n)%loc_src(m)%orient .eq. 4 ) then
TRACER_N(i,j) = ovf(n)%trcr_reg%src(ntr)
endif
if( prnt ) then
write(stdout,10) nsteps_total,n,ovf(n)%loc_src(m)%i_adv, &
ovf(n)%loc_src(m)%j_adv,ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1), &
nsteps_total,n,ovf(n)%loc_src(m)%i_adv, &
ovf(n)%loc_src(m)%j_adv,ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient,ntr, &
CE(i,j)*dz(ksrc)*TAREA(i,j,iblock),CW(i,j)*dz(ksrc)*TAREA(i,j,iblock), &
CN(i,j)*dz(ksrc)*TAREA(i,j,iblock),CS(i,j)*dz(ksrc)*TAREA(i,j,iblock), &
nsteps_total,n,ovf(n)%loc_src(m)%i_adv, &
ovf(n)%loc_src(m)%j_adv,ovf(n)%loc_src(m)%k, &
ovf(n)%loc_src(m)%orient,ntr, &
CE(i,j)*dz(ksrc)*TAREA(i,j,iblock)*TRACER_E(i,j), &
CW(i,j)*dz(ksrc)*TAREA(i,j,iblock)*TRACER_E(i-1,j)
10 format(' Out ovf_advt src ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt src M ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt src CT',i5,1x,6(i3,1x),2(1pe15.8,1x))
endif ! print
endif
end do ! i
endif
end do ! j
endif ! k
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
if( k == kent ) then
do j=1,ny_block
if( ovf(n)%loc_ent(m)%j_adv .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_ent(m)%i_adv .eq. this_block%i_glob(i) ) then
if( prnt ) then
write(stdout,15) nsteps_total,n,ovf(n)%loc_ent(m)%i_adv, &
ovf(n)%loc_ent(m)%j_adv,ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1)
15 format(' In ovf_advt ent ',i5,1x,6(i3,1x),4(1pe15.8,1x))
endif ! print
if( i > 1 ) then
if( ovf(n)%loc_ent(m)%orient .eq. 1 ) then
TRACER_E(i-1,j) = ovf(n)%trcr_reg%ent(ntr)
endif
endif
if( j > 1 ) then
if( ovf(n)%loc_ent(m)%orient .eq. 2 ) then
TRACER_N(i,j-1) = ovf(n)%trcr_reg%ent(ntr)
endif
endif
if( ovf(n)%loc_ent(m)%orient .eq. 3 ) then
TRACER_E(i,j) = ovf(n)%trcr_reg%ent(ntr)
endif
if( ovf(n)%loc_ent(m)%orient .eq. 4 ) then
TRACER_N(i,j) = ovf(n)%trcr_reg%ent(ntr)
endif
if( prnt ) then
write(stdout,20) nsteps_total,n,ovf(n)%loc_ent(m)%i_adv, &
ovf(n)%loc_ent(m)%j_adv,ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1), &
nsteps_total,n,ovf(n)%loc_ent(m)%i_adv, &
ovf(n)%loc_ent(m)%j_adv,ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient,ntr, &
CE(i,j)*dz(kent)*TAREA(i,j,iblock),CW(i,j)*dz(kent)*TAREA(i,j,iblock), &
CN(i,j)*dz(kent)*TAREA(i,j,iblock),CS(i,j)*dz(kent)*TAREA(i,j,iblock), &
nsteps_total,n,ovf(n)%loc_ent(m)%i_adv, &
ovf(n)%loc_ent(m)%j_adv,ovf(n)%loc_ent(m)%k, &
ovf(n)%loc_ent(m)%orient,ntr, &
CE(i,j)*dz(kent)*TAREA(i,j,iblock)*TRACER_E(i,j), &
CW(i,j)*dz(kent)*TAREA(i,j,iblock)*TRACER_E(i-1,j)
20 format(' Out ovf_advt ent ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt ent M ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt ent CT',i5,1x,6(i3,1x),2(1pe15.8,1x))
endif ! print
endif
end do ! i
endif
end do ! j
endif ! k
end do ! entrainment
! prd
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for insertion
kprd = ovf(n)%loc_prd(m,mp)%k
if( k == kprd ) then
do j=1,ny_block
if( ovf(n)%loc_prd(m,mp)%j_adv .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_prd(m,mp)%i_adv .eq. this_block%i_glob(i) ) then
if( prnt ) then
write(stdout,25) nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1)
25 format(' In ovf_advt prd ',i5,1x,6(i3,1x),4(1pe15.8,1x))
endif ! print
if( i > 1 ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) then
TRACER_E(i-1,j) = ovf(n)%trcr_reg%prd(ntr)
endif
endif
if( j > 1 ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) then
TRACER_N(i,j-1) = ovf(n)%trcr_reg%prd(ntr)
endif
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) then
TRACER_E(i,j) = ovf(n)%trcr_reg%prd(ntr)
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) then
TRACER_N(i,j) = ovf(n)%trcr_reg%prd(ntr)
endif
if( prnt ) then
write(stdout,35) nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1), &
nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
CE(i,j)*dz(kprd)*TAREA(i,j,iblock),CW(i,j)*dz(kprd)*TAREA(i,j,iblock), &
CN(i,j)*dz(kprd)*TAREA(i,j,iblock),CS(i,j)*dz(kprd)*TAREA(i,j,iblock), &
nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
CE(i,j)*dz(kprd)*TAREA(i,j,iblock)*TRACER_E(i,j), &
CW(i,j)*dz(kprd)*TAREA(i,j,iblock)*TRACER_E(i-1,j)
35 format(' Out ovf_advt prd ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt prd M ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out ovf_advt prd CT',i5,1x,6(i3,1x),2(1pe15.8,1x))
endif ! print
endif
end do ! i
endif
end do ! j
endif ! k
end do ! product points for insertion set
! If prd set just moved and time averaging done previous time step
if( ovf(n)%prd_set .ne. ovf(n)%prd_set_n ) then
m = ovf(n)%prd_set_n ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for insertion
kprd = ovf(n)%loc_prd(m,mp)%k
if( k == kprd ) then
do j=1,ny_block
if( ovf(n)%loc_prd(m,mp)%j_adv .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_prd(m,mp)%i_adv .eq. this_block%i_glob(i) ) then
if( prnt ) then
write(stdout,26) nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1)
26 format(' In_n ovf_advt prd ',i5,1x,6(i3,1x),4(1pe15.8,1x))
endif ! print
if( avg_ts_last ) then
if( i > 1 ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) then
TRACER_E(i-1,j) = ovf(n)%trcr_reg%prd(ntr)
endif
endif
if( j > 1 ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) then
TRACER_N(i,j-1) = ovf(n)%trcr_reg%prd(ntr)
endif
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) then
TRACER_E(i,j) = ovf(n)%trcr_reg%prd(ntr)
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) then
TRACER_N(i,j) = ovf(n)%trcr_reg%prd(ntr)
endif
endif
if( prnt ) then
write(stdout,36) nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
TRACER_E(i,j),TRACER_E(i-1,j),TRACER_N(i,j),TRACER_N(i,j-1), &
nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
CE(i,j)*dz(kprd)*TAREA(i,j,iblock),CW(i,j)*dz(kprd)*TAREA(i,j,iblock), &
CN(i,j)*dz(kprd)*TAREA(i,j,iblock),CS(i,j)*dz(kprd)*TAREA(i,j,iblock), &
nsteps_total,n,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%loc_prd(m,mp)%orient,ntr, &
CE(i,j)*dz(kprd)*TAREA(i,j,iblock)*TRACER_E(i,j), &
CW(i,j)*dz(kprd)*TAREA(i,j,iblock)*TRACER_E(i-1,j)
36 format(' Out_n ovf_advt prd ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out_n ovf_advt prd M ',i5,1x,6(i3,1x),4(1pe15.8,1x)/ &
' Out_n ovf_advt prd CT',i5,1x,6(i3,1x),2(1pe15.8,1x))
endif ! print
endif
end do ! i
endif
end do ! j
endif ! k
end do ! product points for insertion set
endif
end do ! each overflow
! special diagnostic 11 nov 2008
call ovf_UV_check
!----------------------------------------------------------------------
!EOC
end subroutine ovf_advt
!***********************************************************************
!EOP
! !IROUTINE: ovf_wtkb_check
! !INTERFACE:
subroutine ovf_wtkb_check(k,WTKB,this_block) 1,1
! !DESCRIPTION:
! Print out wtkb for overflow gridboxes
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind), intent(in) :: &
k ! vertical index
real (r8), dimension(nx_block,ny_block,nblocks_clinic), intent(in) :: &
WTKB ! WTKB = W at bottom of t-grid box
type (block), intent(in) :: &
this_block ! block information for this block
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
n,m,mp,i,j, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
iblock ! local block address for this block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_wtkb_check called '
call shr_sys_flush(stdout)
endif
iblock = this_block%local_id
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! ovf ij
! src
do m=1,ovf(n)%num_src ! source
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,10) n,nsteps_total,ovf(n)%loc_src(m)%i, &
ovf(n)%loc_src(m)%j,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
10 format(' ovf_wtkb_ch n=',i3, &
' src t,i,j,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif
endif
end do ! i
endif
end do ! j
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,20) n,nsteps_total,ovf(n)%loc_ent(m)%i, &
ovf(n)%loc_ent(m)%j,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
20 format(' ovf_wtkb_ch n=',i3, &
' ent t,i,j,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif
endif
end do ! i
endif
end do ! j
end do ! entrainment
! prd
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for insertion
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,30) n,nsteps_total,ovf(n)%loc_prd(m,mp)%i, &
ovf(n)%loc_prd(m,mp)%j,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
30 format(' ovf_wtkb_ch n=',i3, &
' prd t,i,j,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif
endif
end do ! i
endif
end do ! j
end do ! product points for insertion set
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for insertion
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,31) n,nsteps_total,ovf(n)%loc_prd(m,mp)%i, &
ovf(n)%loc_prd(m,mp)%j,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
31 format(' ovf_wtkb_ch n=',i3, &
' all prd t,i,j,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif
endif
end do ! i
endif
end do ! j
end do ! product points for insertion set
end do ! product sets
! ovf i_adv j_adv
! src
do m=1,ovf(n)%num_src ! source
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_adv .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_adv .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,40) n,nsteps_total,ovf(n)%loc_src(m)%i_adv, &
ovf(n)%loc_src(m)%j_adv,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
40 format(' ovf_wtkb_ch n=',i3, &
' src t,i_adv,j_adv,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif ! k
endif
end do ! i
endif
end do ! j
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_adv .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_adv .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,50) n,nsteps_total,ovf(n)%loc_ent(m)%i_adv, &
ovf(n)%loc_ent(m)%j_adv,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
50 format(' ovf_wtkb_ch n=',i3, &
' ent t,i_adv,j_adv,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif ! k
endif
end do ! i
endif
end do ! j
end do ! entrainment
! prd
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for insertion
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_adv .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_adv .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,60) n,nsteps_total,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
60 format(' ovf_wtkb_ch n=',i3, &
' prd t,i_adv,j_adv,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif ! k
endif
end do ! i
endif
end do ! j
end do ! product points for insertion set
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for insertion if moved
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_adv .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_adv .eq. this_block%i_glob(i) ) then
if( k == KMT(i,j,iblock) ) then
if( prnt ) then
write(stdout,61) n,nsteps_total,ovf(n)%loc_prd(m,mp)%i_adv, &
ovf(n)%loc_prd(m,mp)%j_adv,k,WTKB(i,j,iblock),TAREA(i,j,iblock)*WTKB(i,j,iblock)
61 format(' ovf_wtkb_ch n=',i3, &
' all prd t,i_adv,j_adv,k wtkb wtkb*tarea=',4(i4,1x),2(1pe12.5,2x))
endif ! print
endif ! k
endif
end do ! i
endif
end do ! j
end do ! product points for insertion set
end do ! original product set if moved
end do ! each overflow
!----------------------------------------------------------------------
!EOC
end subroutine ovf_wtkb_check
!***********************************************************************
!EOP
! !IROUTINE: ovf_UV_check
! !INTERFACE:
subroutine ovf_UV_check 1,4
! !DESCRIPTION:
! Print out column UVEL, VVEL for overflow gridboxes
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
n,m,mp,i,j,k, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
iblock, & ! local block address for this block
ksrc,kent,kprd ! overflow level indices
type (block) :: &
this_block ! block information for this block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_UV_check called '
call shr_sys_flush(stdout)
endif
if( prnt ) then
write(stdout,5) nsteps_total
5 format(' ovf_UV_check called at nsteps_total=',i6)
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
write(stdout,15) n,ovf(n)%loc_src(m)%i_u, &
ovf(n)%loc_src(m)%j_u
15 format(' ovf_UV_check n=',i2,' src i_u j_u = ',2(i3,1x))
! do k=1,ksrc
k=ksrc
! write(stdout,10) k,UVEL(i,j,k,oldtime,iblock), &
! UVEL(i,j,k,curtime,iblock),UVEL(i,j,k,newtime,iblock), &
! VVEL(i,j,k,oldtime,iblock), &
! VVEL(i,j,k,curtime,iblock),VVEL(i,j,k,newtime,iblock)
10 format(' k old cur new UVEL= ',i2,1x,3(f9.5,1x), &
' VVEL=',3(f9.5,1x))
! end do ! k
endif
end do ! i
endif
end do ! j
enddo ! block
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
write(stdout,25) n,ovf(n)%loc_ent(m)%i_u, &
ovf(n)%loc_ent(m)%j_u
25 format(' ovf_UV_check n=',i2,' ent i_u j_u = ',2(i3,1x))
! do k=1,kent
k=kent
! write(stdout,20) k,UVEL(i,j,k,oldtime,iblock), &
! UVEL(i,j,k,curtime,iblock),UVEL(i,j,k,newtime,iblock), &
! VVEL(i,j,k,oldtime,iblock), &
! VVEL(i,j,k,curtime,iblock),VVEL(i,j,k,newtime,iblock)
20 format(' k old cur new UVEL= ',i2,1x,3(f9.5,1x), &
' VVEL=',3(f9.5,1x))
! end do ! k
endif
end do ! i
endif
end do ! j
enddo ! block
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m)
kprd = ovf(n)%loc_prd(m,mp)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
write(stdout,35) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u
35 format(' ovf_UV_check n=',i2,' prd i_u j_u = ',2(i3,1x))
! do k=1,kprd
k=kprd
write(stdout,30) nsteps_total,n, &
ovf(n)%loc_prd(m,mp)%i_u,ovf(n)%loc_prd(m,mp)%j_u, &
k,UVEL(i,j,k,oldtime,iblock), &
UVEL(i,j,k,curtime,iblock),UVEL(i,j,k,newtime,iblock)
30 format(' prd t,n,i,j,k old cur new UVEL= ',5(i4,1x),1x,3(f9.5,1x))
! end do ! k
endif
end do ! i
endif
end do ! j
enddo ! block
end do ! product
end do
end do ! each overflow
endif ! print
!----------------------------------------------------------------------
!EOC
end subroutine ovf_UV_check
!***********************************************************************
!EOP
! !IROUTINE: ovf_Utlda
! !INTERFACE:
subroutine ovf_Utlda(iblock) 1,4
! !DESCRIPTION:
! Save ovf sidewall unnormalized baroclinic velocities Utlda. Must be
! called AFTER the baroclinic solution Utlda is found but BEFORE the
! baroclinic velocities are normalized (i.e. vertical integral of
! baroclinic velocity from surface to bottom topography is zero).
!
! ij t-grid i_u,j_u u-grid
!
! assignment of U on u-grid
! orientation=1 i_u = i j_u = j
! =2 i_u = i-1 j_u = j
! =3 i_u = i-1 j_u = j-1
! =4 i_u = i j_u = j-1
!
! ovf t-grid box ij with u-grid
! corners and orientations
! 2 (i_u,j_u)
! i-1j __________ij
! y ^ | |
! | | |
! | 3 | ij | 1
! +-----> | |
! x |__________|
! i-1j-1 ij-1
! 4
! for example, for ovf grid box ij,
! with product orientation 4, the Utlda
! in the above diagram would be ij-1
! lower right corner
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind), &
intent(in) :: &
iblock ! block index
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
i,j,k,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
ksrc,kent,kprd ! overflow level indices
type (block) :: &
this_block ! block information for current block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_Utlda called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
do k=1,ksrc-1
ovf(n)%loc_src(m)%Utlda(k) = UVEL(i,j,k,newtime,iblock)
ovf(n)%loc_src(m)%Vtlda(k) = VVEL(i,j,k,newtime,iblock)
enddo
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i_u, &
ovf(n)%loc_src(m)%j_u, &
ovf(n)%loc_src(m)%orient,ksrc
10 format(' ovf_Utlda n=',i3, &
' src i_u j_u orient k=',4(i4,1x))
do k=1,ksrc-1
write(stdout,15) k,ovf(n)%loc_src(m)%Utlda(k), &
ovf(n)%loc_src(m)%Vtlda(k)
15 format(' k=',i3,1x,'Utlda Vtlda= ',2(f9.5,2x))
enddo
endif
endif
end do ! i
endif
end do ! j
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
do k=1,kent-1
ovf(n)%loc_ent(m)%Utlda(k) = UVEL(i,j,k,newtime,iblock)
ovf(n)%loc_ent(m)%Vtlda(k) = VVEL(i,j,k,newtime,iblock)
enddo
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i_u, &
ovf(n)%loc_ent(m)%j_u, &
ovf(n)%loc_ent(m)%orient,kent
20 format(' ovf_Utlda n=',i3, &
' ent i_u j_u orient k=',4(i4,1x))
do k=1,kent-1
write(stdout,25) k,ovf(n)%loc_ent(m)%Utlda(k), &
ovf(n)%loc_ent(m)%Vtlda(k)
25 format(' k=',i3,1x,'Utlda Vtlda= ',2(f9.5,2x))
enddo
endif
endif
end do ! i
endif
end do ! j
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
do k=1,kprd-1
ovf(n)%loc_prd(m,mp)%Utlda(k) = UVEL(i,j,k,newtime,iblock)
ovf(n)%loc_prd(m,mp)%Vtlda(k) = VVEL(i,j,k,newtime,iblock)
enddo
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u, &
ovf(n)%loc_prd(m,mp)%orient,kprd
30 format(' ovf_Utlda n=',i3, &
' prd i_u j_u orient k=',4(i4,1x))
do k=1,kprd-1
write(stdout,35) k,ovf(n)%loc_prd(m,mp)%Utlda(k), &
ovf(n)%loc_prd(m,mp)%Vtlda(k)
35 format(' k=',i3,1x,'Utlda Vtlda= ',2(f9.5,2x))
enddo
endif
endif
end do ! i
endif
end do ! j
end do ! product points for each set
end do ! product sets
end do ! each overflow
!----------------------------------------------------------------------
!EOC
end subroutine ovf_Utlda
!***********************************************************************
!EOP
! !IROUTINE: ovf_driver
! !INTERFACE:
subroutine ovf_driver 1,6
! !DESCRIPTION:
! This routine is the main overflow (ovf) driver, called
! in step_mod.F90 between baroclinic and barotropic drivers.
! It calls routines to compute ovf regional means, transports,
! product locations and sidewall velocity evaluation.
!
! !REVISION HISTORY:
! same as module
logical (log_kind), parameter :: prnt = .false.
!EOP
!BOC
if(prnt) then
write(stdout,*) ' ovf_driver entered '
call shr_sys_flush(stdout)
endif
!----------------------------------------------------------------------
!
! ovf regional averages
!
!----------------------------------------------------------------------
call ovf_reg_avgs(curtime)
!----------------------------------------------------------------------
!
! ovf transports
!
!----------------------------------------------------------------------
call ovf_transports
!----------------------------------------------------------------------
!
! ovf location of product
!
!----------------------------------------------------------------------
call ovf_loc_prd
!----------------------------------------------------------------------
!
! ovf top W evaluation
!
!----------------------------------------------------------------------
call ovf_W
!----------------------------------------------------------------------
!
! ovf sidewall UV evaluation
!
!----------------------------------------------------------------------
call ovf_UV
!----------------------------------------------------------------------
!EOC
end subroutine ovf_driver
!***********************************************************************
!EOP
! !IROUTINE: ovf_reg_avgs
! !INTERFACE:
subroutine ovf_reg_avgs(time_level) 2,1
! !DESCRIPTION:
! Evaluate the ovf regional averages
!
! !REVISION HISTORY:
! same as module
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind) :: &! time indices for prognostic arrays
time_level ! current time level (n)
!----------------------------------------------------------------------
!
! local variables
!
!----------------------------------------------------------------------
integer (int_kind) :: &
iblock,k,n,nn,m ! dummy loop indices
type (block) :: &
this_block ! block information for current block
real (r8), dimension(nx_block,ny_block,max_blocks_clinic) :: &
WRK ! temp work array
real (r8) vsum_reg_wght, & ! vertical sum regional weight
vsum_adj_wght ! vertical sum adjacent weight
logical (log_kind), parameter :: prnt = .false.
!EOP
!BOC
if(prnt) then
write(stdout,*) ' ovf_reg_avgs called '
call shr_sys_flush(stdout)
endif
! inflow region
do n=1,num_ovf
if( ovf(n)%wght_reg%inf .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_reg%inf(:,:,iblock)
end do
ovf(n)%wght_reg%inf = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
do nn = 1,nt
ovf(n)%trcr_reg%inf(nn) = c0
end do
vsum_reg_wght = c0
ovf(n)%rho_reg%inf = c0
do k = ovf(n)%reg_inf%kmin, ovf(n)%reg_inf%kmax
vsum_reg_wght = vsum_reg_wght + ovf(n)%wght_reg%inf*dz(k)
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = RHO(:,:,k,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%inf(:,:,iblock)
end do
ovf(n)%rho_reg%inf = ovf(n)%rho_reg%inf + &
global_sum(WRK,distrb_clinic,field_loc_center)
do nn = 1,nt
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = TRACER(:,:,k,nn,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%inf(:,:,iblock)
end do
ovf(n)%trcr_reg%inf(nn) = ovf(n)%trcr_reg%inf(nn) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
end do
do nn = 1,nt
ovf(n)%trcr_reg%inf(nn) = ovf(n)%trcr_reg%inf(nn) / vsum_reg_wght
end do
ovf(n)%rho_reg%inf = ovf(n)%rho_reg%inf / vsum_reg_wght
end do
! source region
do n=1,num_ovf
if( ovf(n)%wght_reg%src .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_reg%src(:,:,iblock)
end do
ovf(n)%wght_reg%src = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
do nn = 1,nt
ovf(n)%trcr_reg%src(nn) = c0
end do
vsum_reg_wght = c0
ovf(n)%rho_reg%src = c0
do k = ovf(n)%reg_src%kmin, ovf(n)%reg_src%kmax
vsum_reg_wght = vsum_reg_wght + ovf(n)%wght_reg%src*dz(k)
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = RHO(:,:,k,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%src(:,:,iblock)
end do
ovf(n)%rho_reg%src = ovf(n)%rho_reg%src + &
global_sum(WRK,distrb_clinic,field_loc_center)
do nn = 1,nt
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = TRACER(:,:,k,nn,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%src(:,:,iblock)
end do
ovf(n)%trcr_reg%src(nn) = ovf(n)%trcr_reg%src(nn) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
end do
do nn = 1,nt
ovf(n)%trcr_reg%src(nn) = ovf(n)%trcr_reg%src(nn) / vsum_reg_wght
end do
ovf(n)%rho_reg%src = ovf(n)%rho_reg%src / vsum_reg_wght
end do
! source adjacent
do n=1,num_ovf
if( ovf(n)%wght_adj%src .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_adj%src(:,:,iblock)
end do
ovf(n)%wght_adj%src = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
do nn = 1,nt
ovf(n)%trcr_adj%src(nn) = c0
end do
vsum_adj_wght = c0
do k = ovf(n)%adj_src%kmin, ovf(n)%adj_src%kmax
vsum_adj_wght = vsum_adj_wght + ovf(n)%wght_adj%src*dz(k)
do nn = 1,nt
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = TRACER(:,:,k,nn,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_adj%src(:,:,iblock)
end do
ovf(n)%trcr_adj%src(nn) = ovf(n)%trcr_adj%src(nn) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
end do
do nn = 1,nt
ovf(n)%trcr_adj%src(nn) = ovf(n)%trcr_adj%src(nn) / vsum_adj_wght
end do
end do
! entrainment region
do n=1,num_ovf
if( ovf(n)%wght_reg%ent .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_reg%ent(:,:,iblock)
end do
ovf(n)%wght_reg%ent = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
do nn = 1,nt
ovf(n)%trcr_reg%ent(nn) = c0
end do
vsum_reg_wght = c0
ovf(n)%rho_reg%ent = c0
do k = ovf(n)%reg_ent%kmin, ovf(n)%reg_ent%kmax
vsum_reg_wght = vsum_reg_wght + ovf(n)%wght_reg%ent*dz(k)
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = RHO(:,:,k,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%ent(:,:,iblock)
end do
ovf(n)%rho_reg%ent = ovf(n)%rho_reg%ent + &
global_sum(WRK,distrb_clinic,field_loc_center)
do nn = 1,nt
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = TRACER(:,:,k,nn,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_reg%ent(:,:,iblock)
end do
ovf(n)%trcr_reg%ent(nn) = ovf(n)%trcr_reg%ent(nn) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
end do
do nn = 1,nt
ovf(n)%trcr_reg%ent(nn) = ovf(n)%trcr_reg%ent(nn) / vsum_reg_wght
end do
ovf(n)%rho_reg%ent = ovf(n)%rho_reg%ent / vsum_reg_wght
end do
! entrainment adjacent
do n=1,num_ovf
if( ovf(n)%wght_adj%ent .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_adj%ent(:,:,iblock)
end do
ovf(n)%wght_adj%ent = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
do nn = 1,nt
ovf(n)%trcr_adj%ent(nn) = c0
end do
vsum_adj_wght = c0
do k = ovf(n)%adj_ent%kmin, ovf(n)%adj_ent%kmax
vsum_adj_wght = vsum_adj_wght + ovf(n)%wght_adj%ent*dz(k)
do nn = 1,nt
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = TRACER(:,:,k,nn,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_adj%ent(:,:,iblock)
end do
ovf(n)%trcr_adj%ent(nn) = ovf(n)%trcr_adj%ent(nn) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
end do
do nn = 1,nt
ovf(n)%trcr_adj%ent(nn) = ovf(n)%trcr_adj%ent(nn) / vsum_adj_wght
end do
end do
! product adjacent
do n=1,num_ovf
do m=1,ovf(n)%num_prd_sets
if( ovf(n)%wght_adj%prd(m) .eq. c0 ) then
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = DXT(:,:,iblock)*DYT(:,:,iblock) &
*ovf(n)%mask_adj%prd(:,:,iblock,m)
end do
ovf(n)%wght_adj%prd(m) = &
global_sum(WRK,distrb_clinic,field_loc_center)
endif
end do
do m=1,ovf(n)%num_prd_sets
vsum_adj_wght = c0
ovf(n)%rho_adj%prd(m) = c0
do k = ovf(n)%adj_prd(m)%kmin, ovf(n)%adj_prd(m)%kmax
vsum_adj_wght = vsum_adj_wght + ovf(n)%wght_adj%prd(m)*dz(k)
do iblock = 1,nblocks_clinic
WRK(:,:,iblock) = RHO(:,:,k,time_level,iblock) &
*DXT(:,:,iblock)*DYT(:,:,iblock)*dz(k) &
*ovf(n)%mask_adj%prd(:,:,iblock,m)
end do
ovf(n)%rho_adj%prd(m) = ovf(n)%rho_adj%prd(m) + &
global_sum(WRK,distrb_clinic,field_loc_center)
end do
ovf(n)%rho_adj%prd(m) = ovf(n)%rho_adj%prd(m) / vsum_adj_wght
end do
end do
if( prnt .and. my_task == master_task ) then
do n=1,num_ovf
write(stdout,10) n,ovf(n)%trcr_reg%inf(1), &
(ovf(n)%trcr_reg%inf(2))*c1000,(ovf(n)%rho_reg%inf-c1)*c1000, &
ovf(n)%trcr_reg%src(1), &
(ovf(n)%trcr_reg%src(2))*c1000,(ovf(n)%rho_reg%src-c1)*c1000, &
ovf(n)%trcr_reg%ent(1), &
(ovf(n)%trcr_reg%ent(2))*c1000,(ovf(n)%rho_reg%ent-c1)*c1000
10 format(1x,'ovf reg',i3,1x,3(f6.3,1x),3(f6.3,1x),3(f6.3,1x))
if( n.eq.1 ) then
write(stdout,11) n,ovf(n)%trcr_adj%src(1), &
(ovf(n)%trcr_adj%src(2))*c1000, &
ovf(n)%trcr_adj%ent(1), &
(ovf(n)%trcr_adj%ent(2))*c1000, &
(ovf(n)%rho_adj%prd(1)-c1)*c1000
11 format(1x,'ovf adj',i3,1x,2(f6.3,1x),1x,2(f6.3,1x),f6.3)
else
write(stdout,12) n,ovf(n)%trcr_adj%src(1), &
(ovf(n)%trcr_adj%src(2))*c1000, &
ovf(n)%trcr_adj%ent(1), &
(ovf(n)%trcr_adj%ent(2))*c1000, &
(ovf(n)%rho_adj%prd(1)-c1)*c1000, &
(ovf(n)%rho_adj%prd(2)-c1)*c1000
12 format(1x,'ovf adj',i3,1x,2(f6.3,1x),1x,2(f6.3,1x), &
f6.3,1x,f6.3)
endif
end do
endif
!----------------------------------------------------------------------
!EOC
end subroutine ovf_reg_avgs
!***********************************************************************
!EOP
! !IROUTINE: ovf_transports
! !INTERFACE:
subroutine ovf_transports 1,5
! !DESCRIPTION:
! Evaluate the ovf transports. For each overflow, set overflow parameters
! and evaluate transports.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
save
integer (int_kind) :: &
n ,& ! ovf loop index
nn ,& ! ovf tracer index
m ,& ! product level
k_p ! product k level
!
real (r8) :: &
lat ,& ! inflow/source latitude for coriolis parameter (degrees)
fs ! coriolis parameter (/s)
!
real (r8) :: &
hu ,& ! upstream source thickness (cm)
hs ,& ! source water vertical thickness (cm)
Ws ,& ! source water width (cm)
xse ,& ! distance from source to entrainment (cm)
di ,& ! depth of inflow (cm)
ds ,& ! depth of source (cm)
de ,& ! depth of entrainment (cm)
dp ,& ! depth of product (cm)
alpha ,& ! continental slope between source to entrainment
cd ! bottom drag coefficient for spreading, entrained flow
!
real (r8) :: &
T_i ,& ! inflow mean temperature (C)
S_i ,& ! inflow mean salinity
T_s ,& ! source mean temperature (C)
S_s ,& ! source mean salinity
T_e ,& ! entrainment mean temperature (C)
S_e ,& ! entrainment mean salinity
T_p ,& ! product temperature (C)
S_p ! product salinity
!
real (r8) :: &
rho_i ,& ! inflow mass density (g/cm3)
rho_s ,& ! source mass density (g/cm3)
rho_e ,& ! entrainment mass density (g/cm3)
rho_sed ,& ! source at entrainment depth mass density (g/cm3)
rho_p ! product mass density (g/cm3)
!
real (r8) :: &
gp_s ,& ! source reduced gravity (cm/s2)
Ms ,& ! source mass flux (Sv)
As ,& ! source cross sectional area (cm2)
Us ! source speed (cm/s)
!
real (r8) :: &
gp_e ,& ! entrainment reduced gravity (cm/s2)
Me ,& ! entrainment mass flux (Sv)
Ue ,& ! entrainment speed (cm/s)
Ugeo ,& ! geostrophic entrainment speed (m/s)
Uavg ,& ! average source and geostrophic speed (cm/s)
a,b,c ,& ! parameters for quadratic solution
Wgeo ,& ! width of geostrophically spread source (cm)
Kgeo ,& ! geostrophic Ekman number
hgeo ,& ! depth of geostrophically spread source (cm)
Fgeo ,& ! Froude number of entrained flow
phi ,& ! entrainment parameter from actual ratio Me/Mp
Mp ! product mass flux (Sv)
logical (log_kind) :: &
print_overflows_diag
character (POP_charLength) :: &
string
integer (POP_i4) :: &
ier
!
!EOP
!BOC
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
! open overflows_diag_outfile file
! append overflows diagnostics to end of overflows diagnostics output file
!
!-----------------------------------------------------------------------
print_overflows_diag = .false.
if (my_task == master_task .and. eod) then
open(ovf_diag_unit, file=overflows_diag_outfile, status='old', position='append')
print_overflows_diag = .true.
endif
! for each overflow
do n=1,num_ovf
! set parameters
lat = ovf(n)%ovf_params%lat
fs = c2*omega*sin(lat*pi/180.0_r8)
hu = ovf(n)%ovf_params%source_thick
hs = hu*(c2/c3)
xse = ovf(n)%ovf_params%distnc_str_ssb
alpha = ovf(n)%ovf_params%bottom_slope
cd = ovf(n)%ovf_params%bottom_drag
di = p5*(zt(ovf(n)%reg_inf%kmin)+zt(ovf(n)%reg_inf%kmax))
ds = zt(ovf(n)%loc_src(1)%k)
de = zt(ovf(n)%loc_ent(1)%k)
Ws = ovf(n)%ovf_params%width
! set region T,S and compute densities
T_i = ovf(n)%trcr_reg%inf(1)
S_i = ovf(n)%trcr_reg%inf(2)
call ovf_state(T_i,S_i,ds,rho_i)
T_s = ovf(n)%trcr_reg%src(1)
S_s = ovf(n)%trcr_reg%src(2)
call ovf_state(T_s,S_s,ds,rho_s)
call ovf_state(T_s,S_s,de,rho_sed)
T_e = ovf(n)%trcr_reg%ent(1)
S_e = ovf(n)%trcr_reg%ent(2)
call ovf_state(T_e,S_e,de,rho_e)
! compute inflow/source reduced gravity and source transport
gp_s = grav*(rho_s-rho_i)/rho_sw
! if no source overflow, zero out transports
if( gp_s > c0 ) then
Ms = gp_s*hu*hu/(c2*fs)
As = hs*Ws
Us = Ms/As
! compute overflow spreading and entrainment transport
gp_e = grav*(rho_sed-rho_e)/rho_sw
! zero entrainment transport if gp_e < 0
if( gp_e > c0 ) then
Ugeo = gp_e*alpha/fs
Uavg = p5*(Us+Ugeo)
a = fs*Ws/c2
b = fs*Ws*hs/c2 + c2*cd*Uavg*xse - Ms*fs/(c2*Ugeo)
c = -fs*Ms*hs/(c2*Ugeo)
hgeo = (-b + sqrt(b*b-c4*a*c))/(c2*a)
Fgeo = Ugeo/sqrt(gp_e*hgeo)
phi = c1-Fgeo**(-c2/c3)
Me = Ms*phi/(c1-phi)
! zero entrainment transport if phi < c0
if( phi > c0 ) then
Mp = Ms + Me
else
Me = c0
Mp = Ms
endif
else
Me = c0
Mp = Ms
endif
else
Ms = c0
Me = c0
Mp = c0
endif
! time shift transports and set output in ovf array
ovf(n)%Ms_nm1 = ovf(n)%Ms_n
ovf(n)%Ms_n = ovf(n)%Ms
ovf(n)%Me_nm1 = ovf(n)%Me_n
ovf(n)%Me_n = ovf(n)%Me
ovf(n)%Mp_nm1 = ovf(n)%Mp_n
ovf(n)%Mp_n = ovf(n)%Mp
ovf(n)%Ms = Ms
ovf(n)%Me = Me
ovf(n)%Mp = Mp
! recompute phi based on actual transports
phi = ovf(n)%Me / (ovf(n)%Mp + c1)
! if time averaging time step, include last time step
if( avg_ts ) then
phi = (ovf(n)%Me_n + ovf(n)%Me) / (ovf(n)%Mp_n + ovf(n)%Mp + c1)
endif
ovf(n)%phi = phi
! compute product T,S
T_p = T_s*(c1-phi) + T_e*phi
S_p = S_s*(c1-phi) + S_e*phi
ovf(n)%Tp = T_p
ovf(n)%Sp = S_p
do nn=1,nt
ovf(n)%trcr_adj%prd(nn) = ovf(n)%trcr_adj%src(nn) * (c1 - phi) &
+ ovf(n)%trcr_adj%ent(nn) * phi
ovf(n)%trcr_reg%prd(nn) = ovf(n)%trcr_reg%src(nn) * (c1 - phi) &
+ ovf(n)%trcr_reg%ent(nn) * phi
end do
! product set for insertion
m = ovf(n)%prd_set
if (print_overflows_diag .and. my_task == master_task) then
k_p = (ovf(n)%adj_prd(m)%kmin+ovf(n)%adj_prd(m)%kmax)/2
write(ovf_diag_unit,1234) tday,n,phi,1.e-12*Ms,1.e-12*Me,1.e-12*Mp,m,zt(k_p)/100.
1234 format(' ovf_tr: ',f7.1,1x,i2,25x,f7.4,2x,3(f7.4,1x),1x,i2,1x,f8.1)
write(ovf_diag_unit,1235) tday, n,T_i,S_i*c1000,T_s,S_s*c1000,T_e,S_e*c1000,T_p,S_p*c1000
1235 format(' ovf_TS: ',f7.1,1x,i2,1x,8(f7.4,1x))
call shr_sys_flush(ovf_diag_unit)
endif ! print_overflows_diag
end do ! n loop over all overflows
!-----------------------------------------------------------------------
!
! close overflows_diag_outfile file
!
!-----------------------------------------------------------------------
if (print_overflows_diag .and. my_task == master_task) then
close(ovf_diag_unit)
endif ! print_overflows_diag
!----------------------------------------------------------------------
!EOC
end subroutine ovf_transports
!***********************************************************************
!EOP
! !IROUTINE: ovf_state
! !INTERFACE:
subroutine ovf_state(TEMPK,SALTK,DEPTHM,RHOFULL) 6,2
! !DESCRIPTION:
! Evaluate ovf state- for given T,S, and depth, compute and return density
!-----------------------------------------------------------------------
! calculate density of water at level k from equation of state
! rho = rho(depth,pot.temperature,salinity). the density can be
! returned as a perturbation (RHOOUT) or as the full density
! (RHOFULL).
!
! This routine also computes derivatives of density with respect
! to temperature and salinity at level k from equation of state
! if requested (ie the optional arguments are present)
!
! * normally kk = k, but kk may = k+1 for adiabatic displacement
! to next lower level
!
! this routine supports three forms of the EOS (see module comments
! at the top)
!-----------------------------------------------------------------------
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables:
!-----------------------------------------------------------------------
real (r8) :: &
TEMPK, & ! temperature at depthm
SALTK ! salinity at depthm
real (r8) :: &
DEPTHM ! depth in centimeters
!-----------------------------------------------------------------------
! output variables:
!-----------------------------------------------------------------------
real (r8) :: &
RHOFULL ! full water density (g/cm3) at level k after adiab disp
!-----------------------------------------------------------------------
! local variables:
!-----------------------------------------------------------------------
save
real (r8) :: &
TQ,SQ, & ! adjusted T,S
BULK_MOD, & ! Bulk modulus
RHO0, & ! density at the surface
SQR,DENOMK, & ! work arrays
WORK1, WORK2, & ! work arrays
WORK3, WORK4, T2
! MWJF numerator coefficients including pressure
real (r8) :: &
mwjfnums0t0, mwjfnums0t1, mwjfnums0t2, mwjfnums0t3, &
mwjfnums1t0, mwjfnums1t1, mwjfnums2t0, &
mwjfdens0t0, mwjfdens0t1, mwjfdens0t2, mwjfdens0t3, mwjfdens0t4, &
mwjfdens1t0, mwjfdens1t1, mwjfdens1t3, &
mwjfdensqt0, mwjfdensqt2
! MWJ numerator coefficients including pressure
real (r8) :: &
mwjnums0t0, mwjnums0t1, mwjnums0t2, mwjnums0t3, &
mwjnums1t0, mwjnums1t1, mwjnums2t0
real (r8) :: p, p2 ! temporary pressure scalars
!-----------------------------------------------------------------------
! MWJF EOS coefficients
!-----------------------------------------------------------------------
! these constants will be used to construct the numerator
! factor unit change (kg/m^3 -> g/cm^3) into numerator terms
real (r8), parameter :: &
p001=.001, &
mwjfnp0s0t0 = 9.99843699e+2 * p001, &
mwjfnp0s0t1 = 7.35212840e+0 * p001, &
mwjfnp0s0t2 = -5.45928211e-2 * p001, &
mwjfnp0s0t3 = 3.98476704e-4 * p001, &
mwjfnp0s1t0 = 2.96938239e+0 * p001, &
mwjfnp0s1t1 = -7.23268813e-3 * p001, &
mwjfnp0s2t0 = 2.12382341e-3 * p001, &
mwjfnp1s0t0 = 1.04004591e-2 * p001, &
mwjfnp1s0t2 = 1.03970529e-7 * p001, &
mwjfnp1s1t0 = 5.18761880e-6 * p001, &
mwjfnp2s0t0 = -3.24041825e-8 * p001, &
mwjfnp2s0t2 = -1.23869360e-11 * p001
! these constants will be used to construct the denominator
real (r8), parameter :: &
mwjfdp0s0t0 = 1.0e+0, &
mwjfdp0s0t1 = 7.28606739e-3, &
mwjfdp0s0t2 = -4.60835542e-5, &
mwjfdp0s0t3 = 3.68390573e-7, &
mwjfdp0s0t4 = 1.80809186e-10, &
mwjfdp0s1t0 = 2.14691708e-3, &
mwjfdp0s1t1 = -9.27062484e-6, &
mwjfdp0s1t3 = -1.78343643e-10, &
mwjfdp0sqt0 = 4.76534122e-6, &
mwjfdp0sqt2 = 1.63410736e-9, &
mwjfdp1s0t0 = 5.30848875e-6, &
mwjfdp2s0t3 = -3.03175128e-16, &
mwjfdp3s0t1 = -1.27934137e-17
logical (log_kind), parameter :: prnt = .false.
!-----------------------------------------------------------------------
if(prnt) then
write(stdout,1234) TEMPK,SALTK*c1000,DEPTHM
1234 format(' Density test input TEMPK,SALTK,DEPTHM = ', &
2(f8.4,2x),f10.1)
call shr_sys_flush(stdout)
endif
if (lccsm_control_compatible) then
TQ = TEMPK
SQ = SALTK*c1000 ! input salt in fraction; convert to ppt
else
TQ = max(-2.0_r8,TEMPK)
SQ = max(c0,SALTK*c1000) ! input salt in fraction; convert to ppt
endif
!-----------------------------------------------------------------------
! now compute density or expansion coefficients
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! McDougall, Wright, Jackett, and Feistel EOS
! test value : rho = 1.033213387 for
! S = 35.0 PSU, theta = 20.0, pressz = 200.0
!-----------------------------------------------------------------------
! depth input as cm; m internal, so convert
p = depthm/100.0_r8
! first calculate numerator of MWJF density [P_1(S,T,p)]
mwjfnums0t0 = mwjfnp0s0t0 + p*(mwjfnp1s0t0 + p*mwjfnp2s0t0)
mwjfnums0t1 = mwjfnp0s0t1
mwjfnums0t2 = mwjfnp0s0t2 + p*(mwjfnp1s0t2 + p*mwjfnp2s0t2)
mwjfnums0t3 = mwjfnp0s0t3
SQR = sqrt(SQ)
! first calculate numerator of MWJF density [P_1(S,T,p)]
mwjfnums0t0 = mwjfnp0s0t0 + p*(mwjfnp1s0t0 + p*mwjfnp2s0t0)
mwjfnums0t1 = mwjfnp0s0t1
mwjfnums0t2 = mwjfnp0s0t2 + p*(mwjfnp1s0t2 + p*mwjfnp2s0t2)
mwjfnums0t3 = mwjfnp0s0t3
mwjfnums1t0 = mwjfnp0s1t0 + p*mwjfnp1s1t0
mwjfnums1t1 = mwjfnp0s1t1
mwjfnums2t0 = mwjfnp0s2t0
WORK1 = mwjfnums0t0 + TQ * (mwjfnums0t1 + TQ * (mwjfnums0t2 + &
mwjfnums0t3 * TQ)) + SQ * (mwjfnums1t0 + &
mwjfnums1t1 * TQ + mwjfnums2t0 * SQ)
! now calculate denominator of MWJF density [P_2(S,T,p)]
mwjfdens0t0 = mwjfdp0s0t0 + p*mwjfdp1s0t0
mwjfdens0t1 = mwjfdp0s0t1 + p**3 * mwjfdp3s0t1
mwjfdens0t2 = mwjfdp0s0t2
mwjfdens0t3 = mwjfdp0s0t3 + p**2 * mwjfdp2s0t3
mwjfdens0t4 = mwjfdp0s0t4
mwjfdens1t0 = mwjfdp0s1t0
mwjfdens1t1 = mwjfdp0s1t1
mwjfdens1t3 = mwjfdp0s1t3
mwjfdensqt0 = mwjfdp0sqt0
mwjfdensqt2 = mwjfdp0sqt2
WORK2 = mwjfdens0t0 + TQ * (mwjfdens0t1 + TQ * (mwjfdens0t2 + &
TQ * (mwjfdens0t3 + mwjfdens0t4 * TQ))) + &
SQ * (mwjfdens1t0 + TQ * (mwjfdens1t1 + TQ*TQ*mwjfdens1t3)+ &
SQR * (mwjfdensqt0 + TQ*TQ*mwjfdensqt2))
DENOMK = c1/WORK2
! output density in g/cm3
RHOFULL = WORK1*DENOMK
if(prnt) then
write(stdout,2345) RHOFULL
2345 format(' ovf_state: RHOFULL output = ',f10.5)
call shr_sys_flush(stdout)
endif
!----------------------------------------------------------------------
!EOC
end subroutine ovf_state
!***********************************************************************
!EOP
! !IROUTINE: ovf_loc_prd
! !INTERFACE:
subroutine ovf_loc_prd 1,8
! !DESCRIPTION:
! Evaluate the ovf location of product. If product location has moved,
! set original sidewall velocities on the ugrid to zero and compute
! Uovf_n, Uovf_nm1 sidewall velocities on the u-grid at new product
! location using Mp_n, Mp_nm1 transport respectively.
!
! !REVISION HISTORY:
! same as module
!
! ovf t-grid box ij with u-grid
! corners and orientations
! product moves out of ij ovf box
!
! ^
! +V | 2
! | __________ ---> +U
! y ^ | | 1
! | | |
! | | ij |
! +-----> | |
! x 3 |__________|
! -U <--- |
! 4 | -V
!EOP
!BOC
!----------------------------------------------------------------------
! local variables
!----------------------------------------------------------------------
integer (int_kind) :: &
m_neut_org, & ! original neutral product density set index
m_neut ! neutral product density set index
real (r8) :: &
T_p ,& ! product temperature (C)
S_p ,& ! product salinity
rho_p ,& ! product density at each product
ufrc ,& ! fraction of ovf velocity for each box
Uovf_n ,& ! U at n
Uovf_nm1 ! U at n-1
integer (int_kind) :: &
iblock,i,j,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
k_p,kprd ! overflow loop and level indices
type (block) :: &
this_block ! block information for current block
logical (log_kind), parameter :: prnt = .false.
if(prnt .and. my_task == master_task) then
write(stdout,*) 'ovf_loc_prd called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf
! find new product location
T_p = ovf(n)%Tp
S_p = ovf(n)%Sp
m_neut_org = ovf(n)%prd_set
m_neut = 0
if(ovf(n)%num_prd_sets .eq. 1) then
m_neut = 1
k_p = (ovf(n)%adj_prd(1)%kmin+ovf(n)%adj_prd(1)%kmax)/2
call ovf_state(T_p,S_p,zt(k_p),rho_p)
else
! search from deepest to shallowest to allow product water
! to go to the deepest possible level
do m=ovf(n)%num_prd_sets-1,1,-1
k_p = (ovf(n)%adj_prd(m)%kmin+ovf(n)%adj_prd(m)%kmax)/2
! get product level for this set
call ovf_state(T_p,S_p,zt(k_p),rho_p)
if(prnt .and. my_task == master_task) then
write(stdout,5) m,(ovf(n)%rho_adj%prd(m-1)-c1)*c1000, &
(ovf(n)%rho_adj%prd(m)-c1)*c1000, &
k_p,T_p,S_p,zt(k_p),(rho_p-c1)*c1000
5 format(' neutral lev search- m rho_adj_m-1 rho_adj_m ', &
'k_p T_p S_p zt(k_p) rho_p =',/ &
2x,i2,2x,2(f12.8,2x),4x,i2,4(f12.8,2x))
endif
if(rho_p .gt. ovf(n)%rho_adj%prd(m)) then
m_neut = m+1
goto 999
else
m_neut = m
endif
enddo
999 continue
endif
! error check
if( m_neut .eq. 0 ) then
write(stdout,10) T_p,S_p,rho_p
10 format(' ovf_loc_prd: no prd lev found for T,S,rho=', &
3(f10.5,2x))
call shr_sys_flush(stdout)
call exit_POP(sigAbort,'ERROR no product level found')
endif
ovf(n)%prd_set_n = m_neut_org
ovf(n)%prd_set = m_neut
if(prnt .and. my_task == master_task) then
write(stdout,20) n,T_p,S_p*c1000,(rho_p-c1)*c1000,m_neut
20 format(' For ovf = ',i3,' prd T,S,rho = ',3(f12.8,2x),' prd set =',i5)
endif
if( m_neut_org .ne. 0 .and. m_neut_org .ne. m_neut ) then
! product point has moved
if ( overflows_on .and. my_task == master_task) then
write(stdout,*) 'ovf_loc_prd: nsteps_total=',nsteps_total, &
' ovf=',n,' swap ovf UV old/new ', &
'prd set old/new=',m_neut_org,m_neut
call shr_sys_flush(stdout)
endif
! compute Uovf_n, Uovf_nm1 velocities for product sidewall
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
ufrc = c1/real(ovf(n)%num_prd(m)-1)
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) then
Uovf_nm1 = ovf(n)%Mp_nm1*ufrc/(dz(kprd)*DYU(i,j,iblock))
Uovf_n = ovf(n)%Mp_n *ufrc/(dz(kprd)*DYU(i,j,iblock))
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) then
Uovf_nm1 = ovf(n)%Mp_nm1*ufrc/(dz(kprd)*DXU(i,j,iblock))
Uovf_n = ovf(n)%Mp_n *ufrc/(dz(kprd)*DXU(i,j,iblock))
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) then
Uovf_nm1 = ovf(n)%Mp_nm1*ufrc/(dz(kprd)*DYU(i,j,iblock))
Uovf_n = ovf(n)%Mp_n *ufrc/(dz(kprd)*DYU(i,j,iblock))
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) then
Uovf_nm1 = ovf(n)%Mp_nm1*ufrc/(dz(kprd)*DXU(i,j,iblock))
Uovf_n = ovf(n)%Mp_n *ufrc/(dz(kprd)*DXU(i,j,iblock))
endif
ovf(n)%loc_prd(m,mp)%Uovf_nm1 = Uovf_nm1
ovf(n)%loc_prd(m,mp)%Uovf_n = Uovf_n
if(prnt) then
write(stdout,30) ovf(n)%loc_prd(m,mp)%i,ovf(n)%loc_prd(m,mp)%j, &
ovf(n)%loc_prd(m,mp)%k,ovf(n)%Mp_nm1,ufrc,dz(kprd),Uovf_nm1
30 format(' loc_prd ijk=',3(i4,1x),'Mp_nm1 uf dz=',3(1pe10.3,1x), &
'Uovf_nm1=',1pe10.3)
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for each set
if( overflows_interactive ) then
! zero out original product sidewall U
m = m_neut_org
do mp=1,ovf(n)%num_prd(m) ! product points for each set
! prd set original Uold sidewalls to zero
kprd = ovf(n)%loc_prd(m,mp)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
UVEL(i,j,kprd,newtime,iblock) = c0
VVEL(i,j,kprd,newtime,iblock) = c0
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for each set
endif ! interactive overflows
endif ! product point has moved
end do ! overflows
!----------------------------------------------------------------------
!EOC
end subroutine ovf_loc_prd
!***********************************************************************
!EOP
! !IROUTINE: ovf_W
! !INTERFACE:
subroutine ovf_W 1,4
! !DESCRIPTION:
! Evaluate ovf vertical velocity W on the t-grid
!
! !REVISION HISTORY:
! same as module
!
! ovf t-grid box ij from top
! sidewall transports and top TAREA
! used to compute Wovf at top
! signs of Wovf important!
!
! __________
! | |
! Me ----> | ij | <---- Ms
! Mp <---- | TAREAij |
! |__________|
!
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
iblock,i,j,n,m,mp, & ! dummy loop indices
ib,ie,jb,je ! local domain index boundaries
type (block) :: &
this_block ! block information for current block
real (r8) :: &
ufrc ! fraction of ovf velocity for each box
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_W called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ufrc = c1/real(ovf(n)%num_src-1)
if(m==1 .or. m==ovf(n)%num_src) ufrc = ufrc/c2
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i .eq. this_block%i_glob(i) ) then
ovf(n)%loc_src(m)%Wovf = -abs(ovf(n)%Ms*ufrc &
/TAREA(i,j,iblock))
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i, &
ovf(n)%loc_src(m)%j,ovf(n)%loc_src(m)%k, &
ovf(n)%Ms,ufrc,TAREA(i,j,iblock), &
ovf(n)%loc_src(m)%Wovf
10 format(' ovf_W n=',i3,' src ijk=',3(i4,1x), &
'Ms uf Ta Wovf=',4(1pe10.3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
ufrc = c1/real(ovf(n)%num_ent-1)
if(m==1 .or. m==ovf(n)%num_ent) ufrc = ufrc/c2
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i .eq. this_block%i_glob(i) ) then
ovf(n)%loc_ent(m)%Wovf = -abs(ovf(n)%Me*ufrc &
/TAREA(i,j,iblock))
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i, &
ovf(n)%loc_ent(m)%j,ovf(n)%loc_ent(m)%k, &
ovf(n)%Me,ufrc,TAREA(i,j,iblock), &
ovf(n)%loc_ent(m)%Wovf
20 format(' ovf_W n=',i3,' ent ijk=',3(i4,1x), &
'Me uf Ta Wovf=',4(1pe10.3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! entrainment
! prd
! set Wovf terms to zero at product points, incase product has moved
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m)
ovf(n)%loc_prd(m,mp)%Wovf = c0
end do
end do
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for each set
ufrc = c1/real(ovf(n)%num_prd(m)-1)
if(mp==1 .or. mp==ovf(n)%num_prd(m)) ufrc = ufrc/c2
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i .eq. this_block%i_glob(i) ) then
ovf(n)%loc_prd(m,mp)%Wovf = abs(ovf(n)%Mp*ufrc &
/TAREA(i,j,iblock))
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i, &
ovf(n)%loc_prd(m,mp)%j,ovf(n)%loc_prd(m,mp)%k, &
ovf(n)%Mp,ufrc,TAREA(i,j,iblock), &
ovf(n)%loc_prd(m,mp)%Wovf
30 format(' ovf_W n=',i3,' prd ijk=',3(i4,1x), &
'Mp uf Ta Wovf=',4(1pe10.3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for insertion set
end do ! each overflow
!----------------------------------------------------------------------
!EOC
end subroutine ovf_W
!***********************************************************************
!EOP
! !IROUTINE: ovf_UV
! !INTERFACE:
subroutine ovf_UV 1,4
! !DESCRIPTION:
! Evaluate the ovf sidewall velocities UV on the u-grid
! !REVISION HISTORY:
! same as module
!
! ovf t-grid box ij with U on u-grid
! at corner set by orientation
!
! 2
! U __________ U
! y ^ | | 1
! | | |
! | | ij |
! +-----> | |
! x 3 |__________|
! U U
! 4
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
iblock,i,j,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
ksrc,kent,kprd ! overflow level indices
type (block) :: &
this_block ! block information for current block
real (r8) :: &
ufrc, & ! fraction of ovf velocity for each box
Uovf ! Uovf at one corner
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_UV called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
ufrc = c1/real(ovf(n)%num_src-1)
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
if( ovf(n)%loc_src(m)%orient .eq. 1 ) then
Uovf = ovf(n)%Ms*ufrc/(dz(ksrc)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,ksrc,newtime,iblock) = -Uovf
endif
endif
if( ovf(n)%loc_src(m)%orient .eq. 2 ) then
Uovf = ovf(n)%Ms*ufrc/(dz(ksrc)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,ksrc,newtime,iblock) = -Uovf
endif
endif
if( ovf(n)%loc_src(m)%orient .eq. 3 ) then
Uovf = ovf(n)%Ms*ufrc/(dz(ksrc)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,ksrc,newtime,iblock) = +Uovf
endif
endif
if( ovf(n)%loc_src(m)%orient .eq. 4 ) then
Uovf = ovf(n)%Ms*ufrc/(dz(ksrc)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,ksrc,newtime,iblock) = +Uovf
endif
endif
ovf(n)%loc_src(m)%Uovf = Uovf
if( prnt ) then
write(stdout,10) n,ovf(n)%loc_src(m)%i_u, &
ovf(n)%loc_src(m)%j_u,ovf(n)%loc_src(m)%k,Uovf
10 format(' ovf_UV n=',i3,' src i_u j_u k Uovf=', &
3(i3,1x),f9.5,2x)
endif ! print
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
ufrc = c1/real(ovf(n)%num_ent-1)
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
if( ovf(n)%loc_ent(m)%orient .eq. 1 ) then
Uovf = ovf(n)%Me*ufrc/(dz(kent)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,kent,newtime,iblock) = -Uovf
endif
endif
if( ovf(n)%loc_ent(m)%orient .eq. 2 ) then
Uovf = ovf(n)%Me*ufrc/(dz(kent)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,kent,newtime,iblock) = -Uovf
endif
endif
if( ovf(n)%loc_ent(m)%orient .eq. 3 ) then
Uovf = ovf(n)%Me*ufrc/(dz(kent)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,kent,newtime,iblock) = +Uovf
endif
endif
if( ovf(n)%loc_ent(m)%orient .eq. 4 ) then
Uovf = ovf(n)%Me*ufrc/(dz(kent)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,kent,newtime,iblock) = +Uovf
endif
endif
ovf(n)%loc_ent(m)%Uovf = Uovf
if( prnt ) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i_u, &
ovf(n)%loc_ent(m)%j_u,ovf(n)%loc_ent(m)%k,Uovf
20 format(' ovf_UV n=',i3,' ent i_u j_u k Uovf=', &
3(i3,1x),f9.5,2x)
endif ! print
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! entrainment
! prd
m = ovf(n)%prd_set ! product set for insertion
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
ufrc = c1/real(ovf(n)%num_prd(m)-1)
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
if( ovf(n)%loc_prd(m,mp)%orient .eq. 1 ) then
Uovf = ovf(n)%Mp*ufrc/(dz(kprd)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,kprd,newtime,iblock) = +Uovf
endif
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 2 ) then
Uovf = ovf(n)%Mp*ufrc/(dz(kprd)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,kprd,newtime,iblock) = +Uovf
endif
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 3 ) then
Uovf = ovf(n)%Mp*ufrc/(dz(kprd)*DYU(i,j,iblock))
if( overflows_interactive ) then
UVEL(i,j,kprd,newtime,iblock) = -Uovf
endif
endif
if( ovf(n)%loc_prd(m,mp)%orient .eq. 4 ) then
Uovf = ovf(n)%Mp*ufrc/(dz(kprd)*DXU(i,j,iblock))
if( overflows_interactive ) then
VVEL(i,j,kprd,newtime,iblock) = -Uovf
endif
endif
ovf(n)%loc_prd(m,mp)%Uovf = Uovf
if( prnt ) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u,ovf(n)%loc_prd(m,mp)%k,Uovf
30 format(' ovf_UV n=',i3,' prd i_u j_u k Uovf=', &
3(i3,1x),f9.5,2x)
endif ! print
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for insertion set
end do ! each overflow
!----------------------------------------------------------------------
!EOC
end subroutine ovf_UV
!***********************************************************************
!EOP
! !IROUTINE: ovf_rhs_brtrpc_momentum
! !INTERFACE:
subroutine ovf_rhs_brtrpc_momentum(ZX,ZY) 1,4
! !DESCRIPTION:
! Renormalize overflow ZX and ZY vertical integrals of forcing
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
real (r8), dimension(nx_block,ny_block,max_blocks_clinic), &
intent(inout) :: &
ZX, ZY ! vertical integrals of forcing
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
i,j,k,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
ksrc,kent,kprd, & ! level indices
iblock ! block index
type (block) :: &
this_block ! block information for current block
real (r8) :: &
dz_sidewall ! sidewall U-grid depth from top to ovf level
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_rhs_brtrpc_momentum called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,ksrc
dz_sidewall = dz_sidewall + dz(k)
enddo
ZX(i,j,iblock) = (ZX(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
ZY(i,j,iblock) = (ZY(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i_u,ovf(n)%loc_src(m)%j_u
10 format(' ovf_rhs_brtrpc_momentum n=',i3, &
' src ZX,ZY adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kent
dz_sidewall = dz_sidewall + dz(k)
enddo
ZX(i,j,iblock) = (ZX(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
ZY(i,j,iblock) = (ZY(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i_u,ovf(n)%loc_ent(m)%j_u
20 format(' ovf_rhs_brtrpc_momentum n=',i3, &
' ent ZX,ZY adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kprd
dz_sidewall = dz_sidewall + dz(k)
enddo
ZX(i,j,iblock) = (ZX(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
ZY(i,j,iblock) = (ZY(i,j,iblock)* HU(i,j,iblock)) &
/ (HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u
30 format(' ovf_rhs_brtrpc_momentum n=',i3, &
' prd ZX,ZY adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for each set
end do ! all product sets
end do ! each overflow
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_rhs_brtrpc_momentum
!***********************************************************************
!EOP
! !IROUTINE: ovf_brtrpc_renorm
! !INTERFACE:
subroutine ovf_brtrpc_renorm(WORK3,WORK4,iblock) 1,4
! !DESCRIPTION:
! Renormalize overflow HU for WORK3 and WORK4 in barotropic solution
! Note- ij limits are 1,nx_block and 1,ny_block to compute ghost values
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
real (r8), dimension(nx_block,ny_block), &
intent(inout) :: &
WORK3,WORK4 ! grid x,y work arrays respectively
integer (int_kind), &
intent(in) :: &
iblock ! block index
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
i,j,k,n,m,mp, & ! dummy loop indices
ksrc,kent,kprd ! level indices
type (block) :: &
this_block ! block information for current block
real (r8) :: &
dz_sidewall ! sidewall U-grid depth from top to ovf level
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_brtrpc_renorm called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
this_block = get_block(blocks_clinic(iblock),iblock)
do j=1,ny_block
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,ksrc
dz_sidewall = dz_sidewall + dz(k)
enddo
WORK3(i,j) = WORK3(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
WORK4(i,j) = WORK4(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i_u, &
ovf(n)%loc_src(m)%j_u
10 format(' ovf_brtrpc_renorm n=',i3, &
' src WORK3/WORK4 adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
this_block = get_block(blocks_clinic(iblock),iblock)
do j=1,ny_block
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kent
dz_sidewall = dz_sidewall + dz(k)
enddo
WORK3(i,j) = WORK3(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
WORK4(i,j) = WORK4(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i_u, &
ovf(n)%loc_ent(m)%j_u
20 format(' ovf_brtrpc_renorm n=',i3, &
' ent WORK3/WORK4 adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
this_block = get_block(blocks_clinic(iblock),iblock)
do j=1,ny_block
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=1,nx_block
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kprd
dz_sidewall = dz_sidewall + dz(k)
enddo
WORK3(i,j) = WORK3(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
WORK4(i,j) = WORK4(i,j)*HUR(i,j,iblock) &
*(HU(i,j,iblock)+dz_sidewall)
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u
30 format(' ovf_brtrpc_renorm n=',i3, &
' prd WORK3/WORK4 adj at i_u j_u=',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! product points for each set
end do ! all product sets
end do ! each overflow
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_brtrpc_renorm
!***********************************************************************
!EOP
! !IROUTINE: ovf_rhs_brtrpc_continuity
! !INTERFACE:
subroutine ovf_rhs_brtrpc_continuity(RHS,iblock) 1,4
! !DESCRIPTION:
! Add overflow vertical velocity to RHS barotropic continuity equation
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
real (r8), dimension(nx_block,ny_block,max_blocks_clinic), &
intent(inout) :: &
RHS ! RHS barotropic continuity equation
integer (int_kind), &
intent(in) :: &
iblock ! block index
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
i,j,n,m,mp, & ! dummy loop indices
ib,ie,jb,je ! local domain index boundaries
type (block) :: &
this_block ! block information for current block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_rhs_brtrpc_continuity called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i .eq. this_block%i_glob(i) ) then
RHS(i,j,iblock) = RHS(i,j,iblock) - (ovf(n)%loc_src(m)%Wovf &
* TAREA(i,j,iblock)/(beta*c2dtp))
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i,ovf(n)%loc_src(m)%j, &
ovf(n)%loc_src(m)%Wovf,TAREA(i,j,iblock)
10 format(' n=',i3,' src RHS adjusted at ij=',2(i3,1x), &
' Wovf=',f9.6,' TAREA=',1pe11.4)
endif
endif
end do ! i
endif
end do ! j
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i .eq. this_block%i_glob(i) ) then
RHS(i,j,iblock) = RHS(i,j,iblock) - (ovf(n)%loc_ent(m)%Wovf &
* TAREA(i,j,iblock)/(beta*c2dtp))
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i,ovf(n)%loc_ent(m)%j, &
ovf(n)%loc_ent(m)%Wovf,TAREA(i,j,iblock)
20 format(' n=',i3,' ent RHS adjusted at ij=',2(i3,1x), &
' Wovf=',f9.6,' TAREA=',1pe11.4)
endif
endif
end do ! i
endif
end do ! j
end do ! entrainment
! prd
m = ovf(n)%prd_set
do mp=1,ovf(n)%num_prd(m) ! product points for each set
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i .eq. this_block%i_glob(i) ) then
RHS(i,j,iblock) = RHS(i,j,iblock) - (ovf(n)%loc_prd(m,mp)%Wovf &
* TAREA(i,j,iblock)/(beta*c2dtp))
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i,ovf(n)%loc_prd(m,mp)%j, &
ovf(n)%loc_prd(m,mp)%Wovf,TAREA(i,j,iblock)
30 format(' n=',i3,' prd RHS adjusted at ij=',2(i3,1x), &
' Wovf=',f9.6,' TAREA=',1pe11.4)
endif
endif
end do ! i
endif
end do ! j
end do ! product points for each set
end do ! each overflow
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_rhs_brtrpc_continuity
!***********************************************************************
!BOP
! !IROUTINE: ovf_solvers_9pt
! !INTERFACE:
subroutine ovf_solvers_9pt 1,20
! !DESCRIPTION:
! This routine updates the coefficients of the 9-point stencils for
! the barotropic operator for the overflow points
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables:
!
! {X,Y}{NE,SE,NW,SW} = contribution to {ne,se,nw,sw} coefficients
! from {x,y} components of divergence
! HU = depth at U points
!
!-----------------------------------------------------------------------
integer (POP_i4) :: &
errorCode, &! error return code
numBlocksTropic, &!num local blocks in barotropic distribution
numBlocksClinic !num local blocks in baroclinic distribution
real (POP_r8) :: &
xne,xse,xnw,xsw, &! contribution to coefficients from x,y
yne,yse,ynw,ysw, &! components of divergence
ase,anw,asw
integer (int_kind) :: &
i,j,n, &! dummy counter
iblock, &! block counter
istat
real (POP_r8), dimension(:,:,:), allocatable :: &
workNorth, &!
workEast, &!
workNE, &!
HUM ! HU if no overflows; modified if overflows
!-----------------------------------------------------------------------
!
! compute nine point operator coefficients: compute on baroclinic
! decomposition first where grid info defined and redistribute
! to barotropic distribution
! leave A0,AC in baroclinic distribution to facilitate easy
! time-dependent changes in barotropic routine
!
!-----------------------------------------------------------------------
call POP_DistributionGet(POP_distrbClinic, errorCode, &
numLocalBlocks = numBlocksClinic)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error retrieving clinic local block count')
! activate later, when errorCode is fully supported
! return
endif
allocate(workNorth (POP_nxBlock,POP_nyBlock,numBlocksClinic), &
workEast (POP_nxBlock,POP_nyBlock,numBlocksClinic), &
workNE (POP_nxBlock,POP_nyBlock,numBlocksClinic), &
HUM (POP_nxBlock,POP_nyBlock,numBlocksClinic), &
stat=istat)
if (istat > 0) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error allocating temporary arrays')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error allocating temporary arrays')
! activate later, when errorCode is fully supported
! return
endif
HUM(:,:,:) = HU(:,:,:)
call ovf_HU(HU,HUM)
call POP_HaloUpdate(HUM, POP_haloClinic, POP_gridHorzLocNECorner,&
POP_fieldKindScalar, errorCode, &
fillValue = 0.0_POP_r8)
!$OMP PARALLEL DO PRIVATE(iblock,i,j,xne,xse,xnw,xsw,yne,yse,ynw,ysw,ase,anw,asw)
do iblock = 1,numBlocksClinic
workNorth (:,:,iblock) = 0.0_POP_r8
workEast (:,:,iblock) = 0.0_POP_r8
workNE (:,:,iblock) = 0.0_POP_r8
centerWgtClinicIndep (:,:,iblock) = 0.0_POP_r8
do j=2,POP_nyBlock
do i=2,POP_nxBlock
xne = 0.25_POP_r8*HUM(i ,j ,iblock)*DXUR(i ,j ,iblock)* &
DYU (i ,j ,iblock)
xse = 0.25_POP_r8*HUM(i ,j-1,iblock)*DXUR(i ,j-1,iblock)* &
DYU (i ,j-1,iblock)
xnw = 0.25_POP_r8*HUM(i-1,j ,iblock)*DXUR(i-1,j ,iblock)* &
DYU (i-1,j ,iblock)
xsw = 0.25_POP_r8*HUM(i-1,j-1,iblock)*DXUR(i-1,j-1,iblock)* &
DYU (i-1,j-1,iblock)
yne = 0.25_POP_r8*HUM(i ,j ,iblock)*DYUR(i ,j ,iblock)* &
DXU (i ,j ,iblock)
yse = 0.25_POP_r8*HUM(i ,j-1,iblock)*DYUR(i ,j-1,iblock)* &
DXU (i ,j-1,iblock)
ynw = 0.25_POP_r8*HUM(i-1,j ,iblock)*DYUR(i-1,j ,iblock)* &
DXU (i-1,j ,iblock)
ysw = 0.25_POP_r8*HUM(i-1,j-1,iblock)*DYUR(i-1,j-1,iblock)* &
DXU (i-1,j-1,iblock)
workNE(i,j,iblock) = xne + yne
ase = xse + yse
anw = xnw + ynw
asw = xsw + ysw
workEast (i,j,iblock) = xne + xse - yne - yse
workNorth(i,j,iblock) = yne + ynw - xne - xnw
centerWgtClinicIndep(i,j,iblock) = &
-(workNE(i,j,iblock) + ase + anw + asw)
end do
end do
end do
!$OMP END PARALLEL DO
!-----------------------------------------------------------------------
!
! redistribute operator weights and mask to barotropic distribution
!
!-----------------------------------------------------------------------
call POP_DistributionGet(POP_distrbTropic, errorCode, &
numLocalBlocks = numBlocksTropic)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error retrieving tropic local block count')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error retrieving tropic local block count')
! activate later, when errorCode is fully supported
! return
endif
call POP_RedistributeBlocks(btropWgtNorth, POP_distrbTropic, &
workNorth, POP_distrbClinic, errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error redistributing north operator weight')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error redistributing north operator weight')
! activate later, when errorCode is fully supported
! return
endif
call POP_RedistributeBlocks(btropWgtEast, POP_distrbTropic, &
workEast, POP_distrbClinic, errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error redistributing east operator weight')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error redistributing east operator weight')
! activate later, when errorCode is fully supported
! return
endif
call POP_RedistributeBlocks(btropWgtNE, POP_distrbTropic, &
workNE, POP_distrbClinic, errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error redistributing NE operator weight')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error redistributing NE operator weight')
! activate later, when errorCode is fully supported
! return
endif
!-----------------------------------------------------------------------
!
! clean up temporary arrays
!
!-----------------------------------------------------------------------
deallocate(workNorth, workEast, workNE, HUM, stat=istat)
if (istat > 0) then
call POP_ErrorSet(errorCode, &
'ovf_solvers_9pt: error deallocating temp mask')
call exit_POP (sigAbort,'ERROR ovf_solvers_9pt: error deallocating temp mask')
! activate later, when errorCode is fully supported
! return
endif
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_solvers_9pt
!***********************************************************************
!EOP
! !IROUTINE: ovf_HU
! !INTERFACE:
subroutine ovf_HU(HU,HUM) 1,4
! !DESCRIPTION:
! Modify HU for overflows sidewalls
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
real (r8), dimension(nx_block,ny_block,max_blocks_clinic), &
intent(in) :: HU ! HU
real (r8), dimension(nx_block,ny_block,max_blocks_clinic), &
intent(inout) :: HUM ! HUM (modified HU)
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
i,j,k,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
ksrc,kent,kprd, & ! level indices
iblock ! block index
real (r8) :: &
dz_sidewall ! sidewall U-grid depth from top to ovf level
type (block) :: &
this_block ! block information for current block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_HU called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
do iblock=1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,ksrc
dz_sidewall = dz_sidewall + dz(k)
enddo
HUM(i,j,iblock) = HU(i,j,iblock) + dz_sidewall
if(prnt) then
write(stdout,10) n, &
ovf(n)%loc_src(m)%i_u,ovf(n)%loc_src(m)%j_u
10 format(' n=',i3,' src HU adjusted at i_u j_u =',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblocks
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
do iblock=1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kent
dz_sidewall = dz_sidewall + dz(k)
enddo
HUM(i,j,iblock) = HU(i,j,iblock) + dz_sidewall
if(prnt) then
write(stdout,20) n, &
ovf(n)%loc_ent(m)%i_u,ovf(n)%loc_ent(m)%j_u
20 format(' n=',i3,' ent HU adjusted at i_u j_u =',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblocks
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
dz_sidewall = c0
do k=KMU(i,j,iblock)+1,kprd
dz_sidewall = dz_sidewall + dz(k)
enddo
HUM(i,j,iblock) = HU(i,j,iblock) + dz_sidewall
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u
30 format(' n=',i3,' prd HU adjusted at i_u j_u =',2(i3,1x))
endif
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for each set
end do ! all product sets
end do ! each overflow
!-----------------------------------------------------------------------
!EOC
end subroutine ovf_HU
!***********************************************************************
!EOP
! !IROUTINE: ovf_UV_solution
! !INTERFACE:
subroutine ovf_UV_solution 1,10
! !DESCRIPTION:
! Evaluate ovf column solution for baroclinic U and V. Should be called
! BEFORE the final addition of baroclinic and barotropic velocities.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
iblock,i,j,k,n,m,mp, & ! dummy loop indices
ib,ie,jb,je, & ! local domain index boundaries
ksrc,kent,kprd ! overflow level indices
real (r8) :: &
Uovf, & ! overflow U
Uovf_nm1, & ! overflow U at n-1
ubar, & ! barotropic velocity
utlda(km) ! unnormalized baroclinic velocity
type (block) :: &
this_block ! block information for current block
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_UV_solution called '
call shr_sys_flush(stdout)
endif
!-----------------------------------------------------------------------
! overflow loop
!-----------------------------------------------------------------------
do n=1,num_ovf ! each overflow
! src
do m=1,ovf(n)%num_src ! source
ksrc = ovf(n)%loc_src(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_src(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_src(m)%i_u .eq. this_block%i_glob(i) ) then
if(prnt) then
write(stdout,10) n,ovf(n)%loc_src(m)%i_u, &
ovf(n)%loc_src(m)%j_u
10 format(' n=',i3,' src iu ju column evaluated=',2(i3,1x))
endif
! U
do k=1,km
utlda(k) = ovf(n)%loc_src(m)%Utlda(k)
enddo
Uovf = UVEL(i,j,ksrc,newtime,iblock)
ubar = UBTROP(i,j,newtime,iblock)
Uovf_nm1 = UVEL(i,j,ksrc,oldtime,iblock)
call ovf_U_column(i,j,ksrc,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
! V
do k=1,km
utlda(k) = ovf(n)%loc_src(m)%Vtlda(k)
enddo
Uovf = VVEL(i,j,ksrc,newtime,iblock)
ubar = VBTROP(i,j,newtime,iblock)
Uovf_nm1 = VVEL(i,j,ksrc,oldtime,iblock)
call ovf_V_column(i,j,ksrc,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! source
! ent
do m=1,ovf(n)%num_ent ! entrainment
kent = ovf(n)%loc_ent(m)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_ent(m)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_ent(m)%i_u .eq. this_block%i_glob(i) ) then
if(prnt) then
write(stdout,20) n,ovf(n)%loc_ent(m)%i_u, &
ovf(n)%loc_ent(m)%j_u
20 format(' n=',i3,' ent iu ju column evaluated=',2(i3,1x))
endif
! U
do k=1,km
utlda(k) = ovf(n)%loc_ent(m)%Utlda(k)
enddo
Uovf = UVEL(i,j,kent,newtime,iblock)
ubar = UBTROP(i,j,newtime,iblock)
Uovf_nm1 = UVEL(i,j,kent,oldtime,iblock)
call ovf_U_column(i,j,kent,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
! V
do k=1,km
utlda(k) = ovf(n)%loc_ent(m)%Vtlda(k)
enddo
Uovf = VVEL(i,j,kent,newtime,iblock)
ubar = VBTROP(i,j,newtime,iblock)
Uovf_nm1 = VVEL(i,j,kent,oldtime,iblock)
call ovf_V_column(i,j,kent,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! entrainment
! prd
do m=1,ovf(n)%num_prd_sets
do mp=1,ovf(n)%num_prd(m) ! product points for each set
kprd = ovf(n)%loc_prd(m,mp)%k
do iblock = 1,nblocks_clinic
this_block = get_block(blocks_clinic(iblock),iblock)
ib = this_block%ib
ie = this_block%ie
jb = this_block%jb
je = this_block%je
do j=jb,je
if( ovf(n)%loc_prd(m,mp)%j_u .eq. this_block%j_glob(j) ) then
do i=ib,ie
if( ovf(n)%loc_prd(m,mp)%i_u .eq. this_block%i_glob(i) ) then
if(prnt) then
write(stdout,30) n,ovf(n)%loc_prd(m,mp)%i_u, &
ovf(n)%loc_prd(m,mp)%j_u
30 format(' n=',i3,' prd iu ju column evaluated=',2(i3,1x))
endif
! U
do k=1,km
utlda(k) = ovf(n)%loc_prd(m,mp)%Utlda(k)
enddo
Uovf = UVEL(i,j,kprd,newtime,iblock)
ubar = UBTROP(i,j,newtime,iblock)
Uovf_nm1 = UVEL(i,j,kprd,oldtime,iblock)
call ovf_U_column(i,j,kprd,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
! V
do k=1,km
utlda(k) = ovf(n)%loc_prd(m,mp)%Vtlda(k)
enddo
Uovf = VVEL(i,j,kprd,newtime,iblock)
ubar = VBTROP(i,j,newtime,iblock)
Uovf_nm1 = VVEL(i,j,kprd,oldtime,iblock)
call ovf_V_column(i,j,kprd,iblock, &
Uovf,ubar,utlda,Uovf_nm1)
endif
end do ! i
endif
end do ! j
end do ! iblock
end do ! product points for each set
end do ! all product sets
end do ! each overflow
!----------------------------------------------------------------------
!EOC
end subroutine ovf_UV_solution
!***********************************************************************
!EOP
! !IROUTINE: ovf_U_column
! !INTERFACE:
subroutine ovf_U_column(i,j,kovf,iblock,Uovf,ubar,utlda,Uovf_nm1) 3,1
! !DESCRIPTION:
! Evaluate ovf column solution for U baroclinic
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind), &
intent(in) :: &
i, & ! local block i index on u-grid
j, & ! local block j index on u-grid
kovf, & ! k index of overflow
iblock ! block index
real (r8), intent(in) :: &
Uovf, & ! overflow U
ubar, & ! barotropic velocity
utlda(km), & ! unnormalized baroclinic velocity
Uovf_nm1 ! overflow U at n-1
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
k ! vertical loop index
real (r8) :: &
uprime, & ! overflow sidewall baroclinic velocity
hu, & ! HU after accumulation of column dz
vert_sum, & ! vertical sum accumulation of utlda*dz
utlda_bar ! vertical mean of utlda
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_U_column called '
call shr_sys_flush(stdout)
endif
! evaluate baroclinic normalization for the overflow column by including
! the overflow contributions along the sidewall above the overflow
! above the topography
hu = c0
vert_sum = c0
do k=1,KMU(i,j,iblock)
hu = hu + dz(k)
vert_sum = vert_sum + utlda(k)*dz(k)
enddo
! below the topography but above the overflow
uprime = -ubar
do k=KMU(i,j,iblock)+1,kovf-1
vert_sum = vert_sum + uprime*dz(k)
enddo
! the overflow contribution
uprime = Uovf - ubar
vert_sum = vert_sum + uprime*dz(kovf)
! adjusted utlda_bar
utlda_bar = vert_sum/hu
! evaluate overflow modified baroclinic velocity for the column
do k=1,KMU(i,j,iblock)
UVEL(i,j,k,newtime,iblock) = utlda(k) - utlda_bar
enddo
! check of zero vertical sum
hu = c0
vert_sum = c0
do k=1,KMU(i,j,iblock)
hu = hu + dz(k)
vert_sum = vert_sum + UVEL(i,j,k,newtime,iblock)*dz(k)
end do
uprime = -ubar
do k=KMU(i,j,iblock)+1,kovf-1
vert_sum = vert_sum + uprime*dz(k)
enddo
uprime = Uovf - ubar
vert_sum = vert_sum + uprime*dz(kovf)
vert_sum = vert_sum / hu
if( prnt ) then
write(stdout,*) 'ovf_U_column '
write(stdout,5) KMU(i,j,iblock),kovf,Uovf,ubar,utlda_bar,Uovf_nm1, &
vert_sum
5 format(' kmu,kovf,Uovf ubar utlda_bar Uovf_nm1 vert_sum='/ &
1x,2(i3,1x),2x,4(f10.5,1x),1pe11.4)
do k=1,kovf
if( k <= KMU(i,j,iblock) ) then
write(stdout,10) k,dz(k),utlda(k)-utlda_bar
10 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
else if( k > KMU(i,j,iblock) .and. k < kovf ) then
write(stdout,15) k,dz(k),-ubar
15 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
else
write(stdout,20) k,dz(k),Uovf-ubar
20 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
endif
end do
endif
!----------------------------------------------------------------------
!EOC
end subroutine ovf_U_column
!***********************************************************************
!EOP
! !IROUTINE: ovf_V_column
! !INTERFACE:
subroutine ovf_V_column(i,j,kovf,iblock,Uovf,ubar,utlda,Uovf_nm1) 3,1
! !DESCRIPTION:
! Evaluate ovf column solution for V baroclinic
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
! input variables
!-----------------------------------------------------------------------
integer (int_kind), &
intent(in) :: &
i, & ! local block i index on u-grid
j, & ! local block j index on u-grid
kovf, & ! k index of overflow
iblock ! block index
real (r8), intent(in) :: &
Uovf, & ! overflow U
ubar, & ! barotropic velocity
utlda(km), & ! unnormalized baroclinic velocity
Uovf_nm1 ! overflow U at n-1
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
k ! vertical loop index
real (r8) :: &
uprime, & ! overflow sidewall baroclinic velocity
hu, & ! HU after accumulation of column dz
vert_sum, & ! vertical sum accumulation of utlda*dz
utlda_bar ! vertical mean of utlda
logical (log_kind), parameter :: prnt = .false.
if( prnt .and. my_task == master_task ) then
write(stdout,*) 'ovf_V_column called '
call shr_sys_flush(stdout)
endif
! evaluate baroclinic normalization for the overflow column by including
! the overflow contributions along the sidewall above the overflow
! above the topography
hu = c0
vert_sum = c0
do k=1,KMU(i,j,iblock)
hu = hu + dz(k)
vert_sum = vert_sum + utlda(k)*dz(k)
enddo
! below the topography but above the overflow
uprime = -ubar
do k=KMU(i,j,iblock)+1,kovf-1
vert_sum = vert_sum + uprime*dz(k)
enddo
! the overflow contribution
uprime = Uovf - ubar
vert_sum = vert_sum + uprime*dz(kovf)
! adjusted utlda_bar
utlda_bar = vert_sum/hu
! evaluate overflow modified baroclinic velocity for the column
do k=1,KMU(i,j,iblock)
VVEL(i,j,k,newtime,iblock) = utlda(k) - utlda_bar
enddo
! check of zero vertical sum
hu = c0
vert_sum = c0
do k=1,KMU(i,j,iblock)
hu = hu + dz(k)
vert_sum = vert_sum + VVEL(i,j,k,newtime,iblock)*dz(k)
end do
uprime = -ubar
do k=KMU(i,j,iblock)+1,kovf-1
vert_sum = vert_sum + uprime*dz(k)
enddo
uprime = Uovf - ubar
vert_sum = vert_sum + uprime*dz(kovf)
vert_sum = vert_sum / hu
if( prnt ) then
write(stdout,*) 'ovf_V_column '
write(stdout,5) KMU(i,j,iblock),kovf,Uovf,ubar,utlda_bar,Uovf_nm1, &
vert_sum
5 format(' kmu,kovf,Uovf ubar utlda_bar Uovf_nm1 vert_sum='/ &
1x,2(i3,1x),2x,4(f10.5,1x),1pe11.4)
do k=1,kovf
if( k <= KMU(i,j,iblock) ) then
write(stdout,10) k,dz(k),utlda(k)-utlda_bar
10 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
else if( k > KMU(i,j,iblock) .and. k < kovf ) then
write(stdout,15) k,dz(k),-ubar
15 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
else
write(stdout,20) k,dz(k),Uovf-ubar
20 format(' k dz U_baroclinic =',i3,1x, &
f8.2,1x,f9.5)
endif
end do
endif
!----------------------------------------------------------------------
!EOC
end subroutine ovf_V_column
!***********************************************************************
end module overflows
!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||