Revision f68b6396784c17398e4d5b4b906818e8b3236e15 authored by Jon Wolfe on 27 October 2023, 15:46:00 UTC, committed by Jon Wolfe on 27 October 2023, 15:46:00 UTC
* proteanplanet/proteanplanet/ocean/pslv: Removes all reference to PSLV in ice_comp comments, since it is never used in MPAS-SI Removes all reference to PSLV in indices, since it is never used in MPAS-SI Tidying up branch to also include update to ice coupling documentation Replace pbot with pslv as atmospheric pressure coupling field for the ocean
prep_wav_mod.F90
module prep_wav_mod
use shr_kind_mod , only: r8 => SHR_KIND_R8
use shr_kind_mod , only: cs => SHR_KIND_CS
use shr_kind_mod , only: cl => SHR_KIND_CL
use shr_sys_mod , only: shr_sys_abort, shr_sys_flush
use seq_comm_mct , only: num_inst_atm, num_inst_ice, num_inst_ocn
use seq_comm_mct , only: num_inst_wav, num_inst_frc
use seq_comm_mct , only: CPLID, WAVID, logunit
use seq_comm_mct , only: seq_comm_getdata=>seq_comm_setptrs
use seq_infodata_mod, only: seq_infodata_getdata, seq_infodata_type
use seq_map_type_mod
use seq_map_mod
use seq_flds_mod
use t_drv_timers_mod
use mct_mod
use perf_mod
use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx
use component_type_mod, only: wav, ocn, ice, atm
implicit none
save
private
!--------------------------------------------------------------------------
! Public interfaces
!--------------------------------------------------------------------------
public :: prep_wav_init
public :: prep_wav_mrg
public :: prep_wav_calc_a2x_wx
public :: prep_wav_calc_o2x_wx
public :: prep_wav_calc_i2x_wx
!--------------------------------------------------------------------------
! Private interfaces
!--------------------------------------------------------------------------
private :: prep_wav_merge
!--------------------------------------------------------------------------
! Private data
!--------------------------------------------------------------------------
! mappers
type(seq_map), pointer :: mapper_sa2w
type(seq_map), pointer :: mapper_so2w
type(seq_map), pointer :: mapper_si2w
! attribute vectors
type(mct_aVect), pointer :: o2x_wx(:) ! Ocn export, wav grid, cpl pes
type(mct_aVect), pointer :: i2x_wx(:) ! Ice export, wav grid, cpl pes
type(mct_aVect), pointer :: a2x_wx(:) ! Atm export, wav grid, cpl pes
! accumulation variables
! none at this time
! seq_comm_getData variables
integer :: mpicom_CPLID ! MPI cpl communicator
!================================================================================================
contains
!================================================================================================
subroutine prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav)
!---------------------------------------------------------------
! Description
! Initialize module attribute vectors and all other non-mapping
! module variables
!
! Arguments
type(seq_infodata_type) , intent(in) :: infodata
logical , intent(in) :: atm_c2_wav ! .true. => atm to wav coupling on
logical , intent(in) :: ocn_c2_wav ! .true. => ocn to wav coupling on
logical , intent(in) :: ice_c2_wav ! .true. => ocn to wav coupling on
!
! Local Variables
integer :: eai , eoi, eii
integer :: lsize_w
logical :: samegrid_ow ! samegrid ocean and wave
logical :: samegrid_aw ! samegrid atm and wave
logical :: iamroot_CPLID ! .true. => CPLID masterproc
logical :: esmf_map_flag ! .true. => use esmf for mapping
logical :: wav_present ! .true. => wav is present
character(CL) :: atm_gnam ! atm grid
character(CL) :: ocn_gnam ! ocn grid
character(CL) :: wav_gnam ! wav grid
type(mct_avect) , pointer :: w2x_wx
character(*) , parameter :: subname = '(prep_wav_init)'
character(*) , parameter :: F00 = "('"//subname//" : ', 4A )"
!---------------------------------------------------------------
call seq_infodata_getData(infodata, &
wav_present=wav_present , &
ocn_gnam=ocn_gnam , &
wav_gnam=wav_gnam , &
atm_gnam=atm_gnam , &
esmf_map_flag=esmf_map_flag )
allocate(mapper_sa2w)
allocate(mapper_so2w)
allocate(mapper_si2w)
if (wav_present) then
call seq_comm_getData(CPLID, mpicom=mpicom_CPLID, iamroot=iamroot_CPLID)
w2x_wx => component_get_c2x_cx(wav(1))
lsize_w = mct_aVect_lsize(w2x_wx)
allocate(a2x_wx(num_inst_atm))
do eai = 1,num_inst_atm
call mct_aVect_init(a2x_wx(eai), rList=seq_flds_a2x_fields, lsize=lsize_w)
call mct_aVect_zero(a2x_wx(eai))
enddo
allocate(o2x_wx(num_inst_ocn))
do eoi = 1,num_inst_ocn
call mct_aVect_init(o2x_wx(eoi), rList=seq_flds_o2x_fields, lsize=lsize_w)
call mct_aVect_zero(o2x_wx(eoi))
enddo
allocate(i2x_wx(num_inst_ice))
do eii = 1,num_inst_ice
call mct_aVect_init(i2x_wx(eii), rList=seq_flds_i2x_fields, lsize=lsize_w)
call mct_aVect_zero(i2x_wx(eii))
enddo
samegrid_ow = .true.
samegrid_aw = .true.
if (trim(ocn_gnam) /= trim(wav_gnam)) samegrid_ow = .false.
if (trim(atm_gnam) /= trim(wav_gnam)) samegrid_aw = .false.
if (atm_c2_wav) then
if (iamroot_CPLID) then
write(logunit,*) ' '
write(logunit,F00) 'Initializing mapper_Sa2w'
end if
call seq_map_init_rcfile(mapper_Sa2w, atm(1), wav(1), &
'seq_maps.rc','atm2wav_smapname:','atm2wav_smaptype:',samegrid_aw, &
'mapper_Sa2w initialization')
endif
call shr_sys_flush(logunit)
if (ocn_c2_wav) then
if (iamroot_CPLID) then
write(logunit,*) ' '
write(logunit,F00) 'Initializing mapper_So2w'
end if
call seq_map_init_rcfile(mapper_So2w, ocn(1), wav(1), &
'seq_maps.rc','ocn2wav_smapname:','ocn2wav_smaptype:',samegrid_ow, &
'mapper_So2w initialization')
endif
call shr_sys_flush(logunit) !TODO ??? is this in Tony's code
if (ice_c2_wav) then
if (iamroot_CPLID) then
write(logunit,*) ' '
write(logunit,F00) 'Initializing mapper_Si2w'
end if
call seq_map_init_rcfile(mapper_Si2w, ice(1), wav(1), &
'seq_maps.rc','ice2wav_smapname:','ice2wav_smaptype:',samegrid_ow, &
'mapper_Si2w initialization')
endif
call shr_sys_flush(logunit)
end if
end subroutine prep_wav_init
!================================================================================================
subroutine prep_wav_mrg(infodata, fractions_wx, timer_mrg)
!---------------------------------------------------------------
! Description
! Merge all wav inputs
!
! Arguments
type(seq_infodata_type) , intent(in) :: infodata
type(mct_aVect) , intent(in) :: fractions_wx(:)
character(len=*) , intent(in) :: timer_mrg
!
! Local Variables
integer :: eai, eoi, eii, ewi, efi
type(mct_avect), pointer :: x2w_wx
character(*), parameter :: subname = '(prep_wav_mrg)'
!---------------------------------------------------------------
call t_drvstartf (trim(timer_mrg),barrier=mpicom_CPLID)
do ewi = 1,num_inst_wav
! Use fortran mod to address ensembles in merge
eai = mod((ewi-1),num_inst_atm) + 1
eoi = mod((ewi-1),num_inst_ocn) + 1
eii = mod((ewi-1),num_inst_ice) + 1
efi = mod((ewi-1),num_inst_frc) + 1
x2w_wx => component_get_x2c_cx(wav(ewi))
call prep_wav_merge(a2x_wx(eai), o2x_wx(eoi), i2x_wx(eii), fractions_wx(efi), x2w_wx)
enddo
call t_drvstopf (trim(timer_mrg))
end subroutine prep_wav_mrg
!================================================================================================
subroutine prep_wav_merge(a2x_w, o2x_w, i2x_w, frac_w, x2w_w)
!-----------------------------------------------------------------------
! Arguments
type(mct_aVect), intent(in) :: a2x_w ! input
type(mct_aVect), intent(in) :: o2x_w ! input
type(mct_aVect), intent(in) :: i2x_w ! input
type(mct_aVect), intent(in) :: frac_w ! input
type(mct_aVect), intent(inout) :: x2w_w ! output
!-----------------------------------------------------------------------
integer :: nflds,i,i1,o1
logical :: iamroot
logical, save :: first_time = .true.
character(CL),allocatable :: mrgstr(:) ! temporary string
character(CL) :: field ! string converted to char
type(mct_aVect_sharedindices),save :: a2x_sharedindices
type(mct_aVect_sharedindices),save :: o2x_sharedindices
type(mct_aVect_sharedindices),save :: i2x_sharedindices
character(*), parameter :: subname = '(prep_wav_merge) '
!-----------------------------------------------------------------------
call seq_comm_getdata(CPLID, iamroot=iamroot)
if (first_time) then
nflds = mct_aVect_nRattr(x2w_w)
allocate(mrgstr(nflds))
do i = 1,nflds
field = mct_aVect_getRList2c(i, x2w_w)
mrgstr(i) = subname//'x2w%'//trim(field)//' ='
enddo
call mct_aVect_setSharedIndices(a2x_w, x2w_w, a2x_SharedIndices)
! QL, 150625, bug?
! a2x_SharedIndices -> o2x_SharedIndices
! a2x_SharedIndices -> i2x_SharedIndices
call mct_aVect_setSharedIndices(o2x_w, x2w_w, o2x_SharedIndices)
call mct_aVect_setSharedIndices(i2x_w, x2w_w, i2x_SharedIndices)
!--- document copy operations ---
do i=1,a2x_SharedIndices%shared_real%num_indices
i1=a2x_SharedIndices%shared_real%aVindices1(i)
o1=a2x_SharedIndices%shared_real%aVindices2(i)
field = mct_aVect_getRList2c(i1, a2x_w)
mrgstr(o1) = trim(mrgstr(o1))//' = a2x%'//trim(field)
enddo
do i=1,o2x_SharedIndices%shared_real%num_indices
i1=o2x_SharedIndices%shared_real%aVindices1(i)
o1=o2x_SharedIndices%shared_real%aVindices2(i)
field = mct_aVect_getRList2c(i1, o2x_w)
mrgstr(o1) = trim(mrgstr(o1))//' = o2x%'//trim(field)
enddo
do i=1,i2x_SharedIndices%shared_real%num_indices
i1=i2x_SharedIndices%shared_real%aVindices1(i)
o1=i2x_SharedIndices%shared_real%aVindices2(i)
field = mct_aVect_getRList2c(i1, i2x_w)
mrgstr(o1) = trim(mrgstr(o1))//' = i2x%'//trim(field)
enddo
endif
! Create input wave state directly from atm, ocn, ice output state
call mct_avect_zero(x2w_w)
call mct_aVect_copy(aVin=a2x_w, aVout=x2w_w, vector=mct_usevector, sharedIndices=a2x_SharedIndices)
call mct_aVect_copy(aVin=o2x_w, aVout=x2w_w, vector=mct_usevector, sharedIndices=o2x_SharedIndices)
call mct_aVect_copy(aVin=i2x_w, aVout=x2w_w, vector=mct_usevector, sharedIndices=i2x_SharedIndices)
if (first_time) then
if (iamroot) then
write(logunit,'(A)') subname//' Summary:'
do i = 1,nflds
write(logunit,'(A)') trim(mrgstr(i))
enddo
endif
deallocate(mrgstr)
endif
first_time = .false.
end subroutine prep_wav_merge
!================================================================================================
subroutine prep_wav_calc_a2x_wx(timer)
!---------------------------------------------------------------
! Description
! Create a2x_wx (note that a2x_wx is a local module variable)
!
! Arguments
character(len=*), intent(in) :: timer
!
! Local Variables
integer :: eai
type(mct_aVect), pointer :: a2x_ax
character(*), parameter :: subname = '(prep_wav_calc_a2x_wx)'
!---------------------------------------------------------------
call t_drvstartf (trim(timer),barrier=mpicom_CPLID)
do eai = 1,num_inst_atm
a2x_ax => component_get_c2x_cx(atm(eai))
call seq_map_map(mapper_Sa2w, a2x_ax, a2x_wx(eai), norm=.true.)
enddo
call t_drvstopf (trim(timer))
end subroutine prep_wav_calc_a2x_wx
!================================================================================================
subroutine prep_wav_calc_o2x_wx(timer)
!---------------------------------------------------------------
! Description
! Create o2x_wx (note that o2x_wx is a local module variable)
!
! Arguments
character(len=*), intent(in) :: timer
!
! Local Variables
integer :: eoi
type(mct_aVect), pointer :: o2x_ox
character(*), parameter :: subname = '(prep_wav_calc_o2x_wx)'
!---------------------------------------------------------------
call t_drvstartf (trim(timer),barrier=mpicom_CPLID)
do eoi = 1,num_inst_ocn
o2x_ox => component_get_c2x_cx(ocn(eoi))
call seq_map_map(mapper_So2w, o2x_ox, o2x_wx(eoi), norm=.true.)
enddo
call t_drvstopf (trim(timer))
end subroutine prep_wav_calc_o2x_wx
!================================================================================================
subroutine prep_wav_calc_i2x_wx(timer)
!---------------------------------------------------------------
! Description
! Create i2x_wx (note that i2x_wx is a local module variable)
!
! Arguments
character(len=*), intent(in) :: timer
!
! Local Variables
integer :: eii
type(mct_aVect), pointer :: i2x_ix
character(*), parameter :: subname = '(prep_wav_calc_i2x_wx)'
!---------------------------------------------------------------
call t_drvstartf (trim(timer),barrier=mpicom_CPLID)
do eii = 1,num_inst_ice
i2x_ix => component_get_c2x_cx(ice(eii))
call seq_map_map(mapper_Si2w, i2x_ix, i2x_wx(eii), norm=.true.)
enddo
call t_drvstopf (trim(timer))
end subroutine prep_wav_calc_i2x_wx
end module prep_wav_mod
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...