Skip to content

Commit

Permalink
Refactor optional argument implementation for isotopes, snwgrain, the…
Browse files Browse the repository at this point in the history 
…rm1 and therm2 (#423)

* Refactor isotope implementation with respect to optional arguments
- Use argcheck design
- Eliminate local copies of optional data
- Pass optional arguments down the calling tree
- Some minor format cleanup

* - Continue update of isotope implementation in Icepack including HDO_ocn, H2_16O_ocn, H2_18O_ocn
- Modify fsloss optional argument implementation
- Modify rsnwn, smicen, smliqn optional argument implementation

* - Update fswtrhu_[vi]d[fr] optional argument implementation
- Clean up some formatting

* Create icepack_chkoptargflag function for optional argument checking
  • Loading branch information
@apcraig
apcraig committed Jan 24, 2023
1 parent 3a4d02e commit 24aef08
Show file tree
Hide file tree
Showing 10 changed files with 414 additions and 506 deletions.
109 changes: 44 additions & 65 deletions columnphysics/icepack_atmo.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,13 +13,14 @@
module icepack_atmo

use icepack_kinds
use icepack_parameters, only: c0, c1, c2, c4, c5, c8, c10
use icepack_parameters, only: c16, c20, p001, p01, p2, p4, p5, p75, puny
use icepack_parameters, only: senscoef, latncoef
use icepack_parameters, only: cp_wv, cp_air, iceruf, zref, qqqice, TTTice, qqqocn, TTTocn
use icepack_parameters, only: Lsub, Lvap, vonkar, Tffresh, zvir, gravit
use icepack_parameters, only: pih, dragio, rhoi, rhos, rhow
use icepack_parameters, only: c0, c1, c2, c4, c5, c8, c10
use icepack_parameters, only: c16, c20, p001, p01, p2, p4, p5, p75, puny
use icepack_parameters, only: senscoef, latncoef
use icepack_parameters, only: cp_wv, cp_air, iceruf, zref, qqqice, TTTice, qqqocn, TTTocn
use icepack_parameters, only: Lsub, Lvap, vonkar, Tffresh, zvir, gravit
use icepack_parameters, only: pih, dragio, rhoi, rhos, rhow
use icepack_parameters, only: atmbndy, calc_strair, formdrag
use icepack_parameters, only: icepack_chkoptargflag
use icepack_tracers, only: n_iso
use icepack_tracers, only: tr_iso
use icepack_warnings, only: warnstr, icepack_warnings_add
Expand Down Expand Up @@ -61,7 +62,6 @@ subroutine atmo_boundary_layer (sfctype, &
Cdn_atm, &
Cdn_atm_ratio_n, &
Qa_iso, Qref_iso, &
iso_flag, &
uvel, vvel, &
Uref, zlvs )

Expand Down Expand Up @@ -103,13 +103,10 @@ subroutine atmo_boundary_layer (sfctype, &
shcoef , & ! transfer coefficient for sensible heat
lhcoef ! transfer coefficient for latent heat

logical (kind=log_kind), intent(in), optional :: &
iso_flag ! flag to trigger iso calculations

real (kind=dbl_kind), intent(in), optional, dimension(:) :: &
real (kind=dbl_kind), intent(in), dimension(:), optional :: &
Qa_iso ! specific isotopic humidity (kg/kg)

real (kind=dbl_kind), intent(inout), optional, dimension(:) :: &
real (kind=dbl_kind), intent(inout), dimension(:), optional :: &
Qref_iso ! reference specific isotopic humidity (kg/kg)

real (kind=dbl_kind), intent(in) :: &
Expand Down Expand Up @@ -167,16 +164,8 @@ subroutine atmo_boundary_layer (sfctype, &
real (kind=dbl_kind), parameter :: &
zTrf = c2 ! reference height for air temp (m)

logical (kind=log_kind) :: &
l_iso_flag ! local flag to trigger iso calculations

character(len=*),parameter :: subname='(atmo_boundary_layer)'

l_iso_flag = .false.
if (present(iso_flag)) then
l_iso_flag = iso_flag
endif

al2 = log(zref/zTrf)

!------------------------------------------------------------
Expand Down Expand Up @@ -389,21 +378,13 @@ subroutine atmo_boundary_layer (sfctype, &
Uref = vmag * rd / rdn
endif

if (l_iso_flag) then
if (present(Qref_iso) .and. present(Qa_iso)) then
if (tr_iso .and. sfctype(1:3)=='ice') then
Qref_iso(:) = c0
if (tr_iso) then
do n = 1, n_iso
ratio = c0
if (Qa_iso(2) > puny) ratio = Qa_iso(n)/Qa_iso(2)
Qref_iso(n) = Qa_iso(n) - ratio*delq*fac
enddo
endif
else
call icepack_warnings_add(subname//' l_iso_flag true but optional arrays missing')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
do n = 1, n_iso
ratio = c0
if (Qa_iso(2) > puny) ratio = Qa_iso(n)/Qa_iso(2)
Qref_iso(n) = Qa_iso(n) - ratio*delq*fac
enddo
endif

end subroutine atmo_boundary_layer
Expand Down Expand Up @@ -895,18 +876,18 @@ subroutine icepack_atm_boundary(sfctype, &
shcoef , & ! transfer coefficient for sensible heat
lhcoef ! transfer coefficient for latent heat

real (kind=dbl_kind), intent(in), optional, dimension(:) :: &
real (kind=dbl_kind), intent(in), dimension(:), optional :: &
Qa_iso ! specific isotopic humidity (kg/kg)

real (kind=dbl_kind), intent(inout), optional, dimension(:) :: &
real (kind=dbl_kind), intent(inout), dimension(:), optional :: &
Qref_iso ! reference specific isotopic humidity (kg/kg)

real (kind=dbl_kind), optional, intent(in) :: &
real (kind=dbl_kind), intent(in), optional :: &
uvel , & ! x-direction ice speed (m/s)
vvel , & ! y-direction ice speed (m/s)
zlvs ! atm level height for scalars (if different than zlvl) (m)

real (kind=dbl_kind), optional, intent(out) :: &
real (kind=dbl_kind), intent(out), optional :: &
Uref ! reference height wind speed (m/s)

!autodocument_end
Expand All @@ -916,14 +897,28 @@ subroutine icepack_atm_boundary(sfctype, &
real (kind=dbl_kind) :: &
l_uvel, l_vvel, l_Uref

real (kind=dbl_kind), dimension(:), allocatable :: &
l_Qa_iso, l_Qref_iso ! local copies of Qa_iso, Qref_iso

logical (kind=log_kind) :: &
iso_flag ! flag to turn on iso calcs in other subroutines
logical (kind=log_kind), save :: &
first_call_ice = .true. ! first call flag

character(len=*),parameter :: subname='(icepack_atm_boundary)'

!------------------------------------------------------------
! Check optional arguments
! Need separate first_call flags for 'ice' and 'ocn' sfctype
!------------------------------------------------------------

if (sfctype == 'ice') then
if (icepack_chkoptargflag(first_call_ice)) then
if (tr_iso) then
if (.not.(present(Qa_iso).and.present(Qref_iso))) then
call icepack_warnings_add(subname//' error in fiso_ocn argument, tr_iso=T')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
endif
endif
endif

l_uvel = c0
l_vvel = c0
l_Uref = c0
Expand All @@ -933,19 +928,6 @@ subroutine icepack_atm_boundary(sfctype, &
if (present(vvel)) then
l_vvel = vvel
endif
if (present(Qa_iso) .and. present(Qref_iso)) then
iso_flag = .true.
allocate(l_Qa_iso(size(Qa_iso,dim=1)))
allocate(l_Qref_iso(size(Qref_iso,dim=1)))
l_Qa_iso = Qa_iso
l_Qref_iso = Qref_iso
else
iso_flag = .false.
allocate(l_Qa_iso(1))
allocate(l_Qref_iso(1))
l_Qa_iso = c0
l_Qref_iso = c0
endif

Cdn_atm_ratio_n = c1

Expand All @@ -972,24 +954,21 @@ subroutine icepack_atm_boundary(sfctype, &
lhcoef, shcoef, &
Cdn_atm, &
Cdn_atm_ratio_n, &
iso_flag = iso_flag, &
Qa_iso=l_Qa_iso, &
Qref_iso=l_Qref_iso, &
uvel=l_uvel, vvel=l_vvel, &
Uref=l_Uref, zlvs=zlvs)
Qa_iso=Qa_iso, &
Qref_iso=Qref_iso, &
uvel=l_uvel, vvel=l_vvel,&
Uref=l_Uref, zlvs=zlvs )
if (icepack_warnings_aborted(subname)) return
endif ! atmbndy

if (present(Uref)) then
Uref = l_Uref
endif

if (present(Qref_iso)) then
Qref_iso = l_Qref_iso
if (sfctype == 'ice') then
first_call_ice = .false.
endif

deallocate(l_Qa_iso,l_Qref_iso)

end subroutine icepack_atm_boundary

!=======================================================================
Expand Down
32 changes: 17 additions & 15 deletions columnphysics/icepack_flux.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,10 +89,6 @@ subroutine merge_fluxes (aicen, &
fsaltn , & ! salt flux to ocean (kg/m2/s)
fhocnn , & ! actual ocn/ice heat flx (W/m**2)
fswthrun, & ! sw radiation through ice bot (W/m**2)
fswthrun_vdr, & ! vis dir sw radiation through ice bot (W/m**2)
fswthrun_vdf, & ! vis dif sw radiation through ice bot (W/m**2)
fswthrun_idr, & ! nir dir sw radiation through ice bot (W/m**2)
fswthrun_idf, & ! nir dif sw radiation through ice bot (W/m**2)
melttn , & ! top ice melt (m)
meltbn , & ! bottom ice melt (m)
meltsn , & ! snow melt (m)
Expand All @@ -102,6 +98,10 @@ subroutine merge_fluxes (aicen, &
snoicen ! snow-ice growth (m)

real (kind=dbl_kind), optional, intent(in):: &
fswthrun_vdr, & ! vis dir sw radiation through ice bot (W/m**2)
fswthrun_vdf, & ! vis dif sw radiation through ice bot (W/m**2)
fswthrun_idr, & ! nir dir sw radiation through ice bot (W/m**2)
fswthrun_idf, & ! nir dif sw radiation through ice bot (W/m**2)
Urefn ! air speed reference level (m/s)

! cumulative fluxes
Expand Down Expand Up @@ -129,7 +129,6 @@ subroutine merge_fluxes (aicen, &
meltb , & ! bottom ice melt (m)
melts , & ! snow melt (m)
meltsliq, & ! mass of snow melt (kg/m^2)
dsnow , & ! change in snow depth (m)
congel , & ! congelation ice growth (m)
snoice ! snow-ice growth (m)

Expand All @@ -139,18 +138,19 @@ subroutine merge_fluxes (aicen, &
fswthru_idr , & ! nir dir sw radiation through ice bot (W/m**2)
fswthru_idf ! nir dif sw radiation through ice bot (W/m**2)

real (kind=dbl_kind), optional, intent(inout):: &
real (kind=dbl_kind), intent(inout), optional :: &
dsnow, & ! change in snow depth (m)
Uref ! air speed reference level (m/s)

real (kind=dbl_kind), optional, dimension(:), intent(inout):: &
Qref_iso, & ! isotope air sp hum reference level (kg/kg)
fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s)
fiso_evap ! isotope evaporation (kg/m2/s)
real (kind=dbl_kind), dimension(:), intent(inout), optional :: &
Qref_iso, & ! isotope air sp hum ref level (kg/kg)
fiso_ocn, & ! isotope fluxes to ocean (kg/m2/s)
fiso_evap ! isotope evaporation (kg/m2/s)

real (kind=dbl_kind), optional, dimension(:), intent(in):: &
Qrefn_iso, & ! isotope air sp hum reference level (kg/kg)
fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s)
fiso_evapn ! isotope evaporation (kg/m2/s)
real (kind=dbl_kind), dimension(:), intent(in), optional :: &
Qrefn_iso, & ! isotope air sp hum ref level (kg/kg)
fiso_ocnn, & ! isotope fluxes to ocean (kg/m2/s)
fiso_evapn ! isotope evaporation (kg/m2/s)

character(len=*),parameter :: subname='(merge_fluxes)'

Expand Down Expand Up @@ -220,7 +220,9 @@ subroutine merge_fluxes (aicen, &
if (tr_snow) then
meltsliq = meltsliq + meltsliqn * aicen
endif
dsnow = dsnow + dsnown * aicen
if (present(dsnow)) then
dsnow = dsnow + dsnown * aicen
endif
congel = congel + congeln * aicen
snoice = snoice + snoicen * aicen

Expand Down
22 changes: 13 additions & 9 deletions columnphysics/icepack_isotope.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,21 +83,24 @@ subroutine update_isotope (dt, &
aicen, & ! ice area
aice_old, & ! beginning values
vice_old, &
vsno_old, &
HDO_ocn, & !
H2_16O_ocn, & !
H2_18O_ocn !

real (kind=dbl_kind), dimension(:), intent(in) :: &
fiso_atm, & ! isotopic snowfall (kg/m^2/s of water)
Qref_iso ! isotope reference humidity
vsno_old

real (kind=dbl_kind), dimension(:), intent(inout) :: &
fiso_ocnn, & ! isotopic freshwater (kg/m^2/s)
fiso_evapn ! evaporative water flux (kg/m^2/s)

real (kind=dbl_kind), dimension(:), intent(inout) :: &
isosno, isoice ! mass of isotopes (kg)
isosno, & ! mass of isotopes (kg)
isoice

real (kind=dbl_kind), dimension(:), intent(in) :: &
fiso_atm, & ! isotopic snowfall (kg/m^2/s of water)
Qref_iso ! isotope reference humidity

real (kind=dbl_kind), intent(in) :: &
HDO_ocn, & ! ocean concentration of HDO (kg/kg)
H2_16O_ocn, & ! ocean concentration of H2_16O (kg/kg)
H2_18O_ocn ! ocean concentration of H2_18O (kg/kg)

! local variables

Expand Down Expand Up @@ -197,6 +200,7 @@ subroutine update_isotope (dt, &

if (congel > c0) then
do k = 1,n_iso
work = c0
if (k == 1) then
alpha = isoice_alpha(congel/dt,'HDO',isotope_frac_method)
work = alpha*HDO_ocn*rhoi*congel*aicen
Expand Down
2 changes: 1 addition & 1 deletion columnphysics/icepack_itd.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -833,7 +833,7 @@ subroutine cleanup_itd (dt, ntrcr, &
real (kind=dbl_kind), dimension (:), intent(inout), optional :: &
faero_ocn ! aerosol flux to ocean (kg/m^2/s)

real (kind=dbl_kind), dimension (:), intent(inout) :: &
real (kind=dbl_kind), dimension (:), intent(inout), optional :: &
fiso_ocn ! isotope flux to ocean (kg/m^2/s)

logical (kind=log_kind), intent(in), optional :: &
Expand Down
Loading

0 comments on commit 24aef08

Please sign in to comment.