Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Refactor optional argument implementation for isotopes, snwgrain, therm1 and therm2 #423

Merged
merged 4 commits into from
Jan 24, 2023
Merged

Refactor optional argument implementation for isotopes, snwgrain, therm1 and therm2 #423

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
fb45b9e
Refactor isotope implementation with respect to optional arguments
apcraig Jan 11, 2023
7b2ad22
- Continue update of isotope implementation in Icepack including HDO_…
apcraig Jan 12, 2023
0c57334
- Update fswtrhu_[vi]d[fr] optional argument implementation
apcraig Jan 14, 2023
9e28d92
Create icepack_chkoptargflag function for optional argument checking
apcraig Jan 23, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
82 changes: 22 additions & 60 deletions columnphysics/icepack_atmo.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,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 +102,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 +163,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 +377,21 @@ 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 (present(Qref_iso)) 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
if (present(Qa_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
else
call icepack_warnings_add(subname//' Qref_iso and Qa_iso both must be passed with tr_iso')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
endif
else
call icepack_warnings_add(subname//' l_iso_flag true but optional arrays missing')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
endif

end subroutine atmo_boundary_layer
Expand Down Expand Up @@ -895,18 +883,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,12 +904,6 @@ 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

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

l_uvel = c0
Expand All @@ -933,19 +915,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 +941,17 @@ 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, &
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What happens if present(Qref_iso)=F? Is this robust across all compilers/platforms? You probably tested that previously...

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is robust. The optional attribute and "present" state is passed down the calling tree. As long as optional is set in the calling routine for this field if want to check it's "present" state (determined by the original caller) and/or the optional argument is not used unless it exists, all should be fine. You can definitely get into trouble if you pass the optional argument down the calling tree and use it if it wasn't passed. Hopefully, we'll avoid that with the logic we have setup.

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
endif

deallocate(l_Qa_iso,l_Qref_iso)

end subroutine icepack_atm_boundary

!=======================================================================
Expand Down
4 changes: 2 additions & 2 deletions columnphysics/icepack_isotope.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,15 +88,15 @@ subroutine update_isotope (dt, &
H2_16O_ocn, & !
H2_18O_ocn !

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

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) :: &
real (kind=dbl_kind), dimension(:), intent(inout), optional :: &
isosno, isoice ! mass of isotopes (kg)

! local variables
Expand Down
2 changes: 1 addition & 1 deletion columnphysics/icepack_itd.F90
View file
Open in desktop
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
50 changes: 29 additions & 21 deletions columnphysics/icepack_mechred.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,10 @@
module icepack_mechred

use icepack_kinds
use icepack_parameters, only: c0, c1, c2, c10, c25, Cf, Cp, Pstar, Cstar
use icepack_parameters, only: p05, p15, p25, p333, p5
use icepack_parameters, only: puny, Lfresh, rhoi, rhos
use icepack_parameters, only: c0, c1, c2, c10, c25, Cf, Cp, Pstar, Cstar
use icepack_parameters, only: p05, p15, p25, p333, p5
use icepack_parameters, only: puny, Lfresh, rhoi, rhos
use icepack_parameters, only: argcheck

use icepack_parameters, only: kstrength, krdg_partic, krdg_redist, mu_rdg
use icepack_parameters, only: conserv_check
Expand Down Expand Up @@ -188,7 +189,7 @@ subroutine ridge_ice (dt, ndtd, &
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)

! local variables
Expand Down Expand Up @@ -1804,7 +1805,7 @@ subroutine icepack_step_ridge (dt, ndtd, &
faero_ocn, & ! aerosol flux to ocean (kg/m^2/s)
flux_bio ! all bio fluxes to ocean

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

real (kind=dbl_kind), dimension(:,:), intent(inout) :: &
Expand All @@ -1825,33 +1826,41 @@ subroutine icepack_step_ridge (dt, ndtd, &
real (kind=dbl_kind) :: &
dtt ! thermo time step

real (kind=dbl_kind), dimension(:), allocatable :: &
l_fiso_ocn ! local isotope flux to ocean (kg/m^2/s)

real (kind=dbl_kind) :: &
l_closing ! local rate of closing due to divergence/shear (1/s)

logical (kind=log_kind) :: &
l_closing_flag ! flag if closing is passed

logical (kind=log_kind), save :: &
first_call = .true. ! first call flag

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

!-----------------------------------------------------------------
! Check optional arguments
!-----------------------------------------------------------------

if (argcheck == 'always' .or. (argcheck == 'first' .and. first_call)) then
if (tr_iso) then
if (present(fiso_ocn)) then
! OK
else
apcraig marked this conversation as resolved.
Show resolved Hide resolved
call icepack_warnings_add(subname//' error in fiso_ocn argument, tr_iso=T')
call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
return
endif
endif
endif


!-----------------------------------------------------------------
! Identify ice-ocean cells.
! Note: We can not limit the loop here using aice>puny because
! aice has not yet been updated since the transport (and
! it may be out of whack, which the ridging helps fix).-ECH
!-----------------------------------------------------------------

if (present(fiso_ocn)) then
allocate(l_fiso_ocn(size(fiso_ocn)))
l_fiso_ocn = fiso_ocn
else
! check tr_iso = true ???
allocate(l_fiso_ocn(1))
l_fiso_ocn = c0
endif

if (present(closing)) then
l_closing_flag = .true.
l_closing = closing
Expand Down Expand Up @@ -1879,7 +1888,7 @@ subroutine icepack_step_ridge (dt, ndtd, &
dvirdgdt, opening, &
fpond, &
fresh, fhocn, &
faero_ocn, l_fiso_ocn, &
faero_ocn, fiso_ocn, &
aparticn, krdgn, &
aredistn, vredistn, &
dardg1ndt, dardg2ndt, &
Expand Down Expand Up @@ -1910,13 +1919,12 @@ subroutine icepack_step_ridge (dt, ndtd, &
n_trcr_strata, nt_strata, &
fpond, fresh, &
fsalt, fhocn, &
faero_ocn, l_fiso_ocn, &
faero_ocn, fiso_ocn, &
fzsal, &
flux_bio)
if (icepack_warnings_aborted(subname)) return

if (present(fiso_ocn)) fiso_ocn = l_fiso_ocn
deallocate(l_fiso_ocn)
first_call = .false.

end subroutine icepack_step_ridge

Expand Down
2 changes: 1 addition & 1 deletion columnphysics/icepack_snow.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -919,7 +919,7 @@ subroutine snow_dry_metamorph (nslyr,nilyr, dt, rsnw, drsnw_dry, zqsn, &
dzi, & ! ice layer thickness (m)
dz ! dzs + dzi (m)

logical (kind=log_kind) :: &
logical (kind=log_kind), save :: &
first_call = .true. ! first call flag

character (char_len) :: &
Expand Down
Loading