From 67c874194a4acdaf09fc756cd679f579fa53060d Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 14 Feb 2023 12:42:26 -0700 Subject: [PATCH] Update implementation of some optional arguments in Icepack - Remove local copies where possible - Check optional arguments Remove public interface declarations where not needed Clean up some intent statements --- columnphysics/icepack_fsd.F90 | 12 +- columnphysics/icepack_itd.F90 | 10 +- columnphysics/icepack_mechred.F90 | 39 ++---- columnphysics/icepack_orbital.F90 | 15 +++ columnphysics/icepack_shortwave.F90 | 156 ++++++++--------------- columnphysics/icepack_therm_bl99.F90 | 59 +++------ columnphysics/icepack_therm_itd.F90 | 5 +- columnphysics/icepack_therm_vertical.F90 | 12 +- columnphysics/icepack_tracers.F90 | 2 +- 9 files changed, 115 insertions(+), 195 deletions(-) diff --git a/columnphysics/icepack_fsd.F90 b/columnphysics/icepack_fsd.F90 index 4d89ca845..bee46cd35 100644 --- a/columnphysics/icepack_fsd.F90 +++ b/columnphysics/icepack_fsd.F90 @@ -120,18 +120,10 @@ subroutine icepack_init_fsd_bounds(nfsd, & real (kind=dbl_kind), dimension(:), allocatable :: & lims - logical (kind=log_kind) :: & - l_write_diags ! local write diags - character(len=8) :: c_fsd1,c_fsd2 character(len=2) :: c_nf character(len=*), parameter :: subname='(icepack_init_fsd_bounds)' - l_write_diags = .true. - if (present(write_diags)) then - l_write_diags = write_diags - endif - if (nfsd.eq.24) then allocate(lims(24+1)) @@ -230,7 +222,8 @@ subroutine icepack_init_fsd_bounds(nfsd, & c_fsd_range(n)=c_fsd1//'m < fsd Cat '//c_nf//' < '//c_fsd2//'m' enddo - if (l_write_diags) then + if (present(write_diags)) then + if (write_diags) then write(warnstr,*) ' ' call icepack_warnings_add(warnstr) write(warnstr,*) subname @@ -244,6 +237,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & write(warnstr,*) ' ' call icepack_warnings_add(warnstr) endif + endif end subroutine icepack_init_fsd_bounds diff --git a/columnphysics/icepack_itd.F90 b/columnphysics/icepack_itd.F90 index 00f0f768f..3c18a4e13 100644 --- a/columnphysics/icepack_itd.F90 +++ b/columnphysics/icepack_itd.F90 @@ -997,10 +997,12 @@ subroutine cleanup_itd (dt, ntrcr, & faero_ocn(it) = faero_ocn(it) + dfaero_ocn(it) enddo endif - if (tr_iso) then - do it = 1, n_iso - fiso_ocn(it) = fiso_ocn(it) + dfiso_ocn(it) - enddo + if (present(fiso_ocn)) then + if (tr_iso) then + do it = 1, n_iso + fiso_ocn(it) = fiso_ocn(it) + dfiso_ocn(it) + enddo + endif endif if (present(flux_bio)) then do it = 1, nbtrcr diff --git a/columnphysics/icepack_mechred.F90 b/columnphysics/icepack_mechred.F90 index 4dc87cb28..ea049761f 100644 --- a/columnphysics/icepack_mechred.F90 +++ b/columnphysics/icepack_mechred.F90 @@ -58,10 +58,7 @@ module icepack_mechred implicit none private - public :: ridge_ice, & - asum_ridging, & - ridge_itd, & - icepack_ice_strength, & + public :: icepack_ice_strength, & icepack_step_ridge real (kind=dbl_kind), parameter :: & @@ -113,7 +110,7 @@ subroutine ridge_ice (dt, ndtd, & dardg1ndt, dardg2ndt, & dvirdgndt, & araftn, vraftn, & - closing_flag,closing ) + closing ) integer (kind=int_kind), intent(in) :: & ndtd , & ! number of dynamics subcycles @@ -161,7 +158,6 @@ subroutine ridge_ice (dt, ndtd, & krdg_redist ! selects redistribution function logical (kind=log_kind), intent(in) :: & - closing_flag, &! flag if closing is valid tr_brine ! if .true., brine height differs from ice thickness ! optional history fields @@ -296,7 +292,7 @@ subroutine ridge_ice (dt, ndtd, & ! Compute the area opening and closing. !----------------------------------------------------------------- - if (closing_flag) then + if (present(opening) .and. present(closing)) then opning = opening closing_net = closing @@ -595,11 +591,13 @@ subroutine ridge_ice (dt, ndtd, & faero_ocn(it) = faero_ocn(it) + maero(it)*dti enddo endif - if (tr_iso) then - ! check size fiso_ocn vs n_iso ??? - do it = 1, n_iso - fiso_ocn(it) = fiso_ocn(it) + miso(it)*dti - enddo + if (present(fiso_ocn)) then + if (tr_iso) then + ! check size fiso_ocn vs n_iso ??? + do it = 1, n_iso + fiso_ocn(it) = fiso_ocn(it) + miso(it)*dti + enddo + endif endif if (present(fpond)) then fpond = fpond - mpond ! units change later @@ -1826,12 +1824,6 @@ subroutine icepack_step_ridge (dt, ndtd, & real (kind=dbl_kind) :: & dtt ! thermo time step - 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 @@ -1859,14 +1851,6 @@ subroutine icepack_step_ridge (dt, ndtd, & ! it may be out of whack, which the ridging helps fix).-ECH !----------------------------------------------------------------- - if (present(closing)) then - l_closing_flag = .true. - l_closing = closing - else - l_closing_flag = .false. - l_closing = c0 - endif - call ridge_ice (dt, ndtd, & ncat, n_aero, & nilyr, nslyr, & @@ -1892,8 +1876,7 @@ subroutine icepack_step_ridge (dt, ndtd, & dardg1ndt, dardg2ndt, & dvirdgndt, & araftn, vraftn, & - l_closing_flag, & - l_closing ) + closing ) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- diff --git a/columnphysics/icepack_orbital.F90 b/columnphysics/icepack_orbital.F90 index 4c7c53ccf..13f9d4824 100644 --- a/columnphysics/icepack_orbital.F90 +++ b/columnphysics/icepack_orbital.F90 @@ -177,11 +177,24 @@ subroutine compute_coszen (tlat, tlon, & real (kind=dbl_kind) :: ydayp1 ! day of year plus one time step + logical (kind=log_kind), save :: & + first_call = .true. ! first call flag + character(len=*),parameter :: subname='(compute_coszen)' ! Solar declination for next time step #ifdef CESMCOUPLED + if (icepack_chkoptargflag(first_call)) then + if (.not.(present(days_per_year) .and. & + present(nextsw_cday) .and. & + present(calendar_type))) then + call icepack_warnings_add(subname//' error in CESMCOUPLED args') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + return + endif + endif + if (calendar_type == "GREGORIAN") then ydayp1 = min(nextsw_cday, real(days_per_year,kind=dbl_kind)) else @@ -206,6 +219,8 @@ subroutine compute_coszen (tlat, tlon, & endif #endif + first_call = .false. + end subroutine compute_coszen !=============================================================================== diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90 index 1063c4b29..d30214345 100644 --- a/columnphysics/icepack_shortwave.F90 +++ b/columnphysics/icepack_shortwave.F90 @@ -66,10 +66,7 @@ module icepack_shortwave implicit none private - public :: run_dEdd, & - shortwave_ccsm3, & - compute_shortwave_trcr, & - icepack_prep_radiation, & + public :: icepack_prep_radiation, & icepack_step_radiation real (kind=dbl_kind), parameter :: & @@ -178,11 +175,11 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alvdfns, & ! visible, diffuse, snow (fraction) alidfns ! near-ir, diffuse, snow (fraction) - real (kind=dbl_kind), dimension(:), allocatable :: & - l_fswthru_vdr , & ! vis dir SW through ice to ocean (W m-2) - l_fswthru_vdf , & ! vis dif SW through ice to ocean (W m-2) - l_fswthru_idr , & ! nir dir SW through ice to ocean (W m-2) - l_fswthru_idf ! nir dif SW through ice to ocean (W m-2) + real (kind=dbl_kind) :: & + l_fswthru_vdr, & ! vis dir SW through ice to ocean (W m-2) + l_fswthru_vdf, & ! vis dif SW through ice to ocean (W m-2) + l_fswthru_idr, & ! nir dir SW through ice to ocean (W m-2) + l_fswthru_idf ! nir dif SW through ice to ocean (W m-2) character(len=*),parameter :: subname='(shortwave_ccsm3)' @@ -190,11 +187,6 @@ subroutine shortwave_ccsm3 (aicen, vicen, & ! Solar radiation: albedo and absorbed shortwave !----------------------------------------------------------------- - allocate(l_fswthru_vdr(ncat)) - allocate(l_fswthru_vdf(ncat)) - allocate(l_fswthru_idr(ncat)) - allocate(l_fswthru_idf(ncat)) - ! For basic shortwave, set coszen to a constant between 0 and 1. coszen = p5 ! sun above the horizon @@ -295,29 +287,24 @@ subroutine shortwave_ccsm3 (aicen, vicen, & fswsfc=fswsfc(n), & fswint=fswint(n), & fswthru=fswthru(n), & - fswthru_vdr=l_fswthru_vdr(n),& - fswthru_vdf=l_fswthru_vdf(n),& - fswthru_idr=l_fswthru_idr(n),& - fswthru_idf=l_fswthru_idf(n),& + fswthru_vdr=l_fswthru_vdr,& + fswthru_vdf=l_fswthru_vdf,& + fswthru_idr=l_fswthru_idr,& + fswthru_idf=l_fswthru_idf,& fswpenl=fswpenl(:,n), & Iswabs=Iswabs(:,n)) if (icepack_warnings_aborted(subname)) return + if(present(fswthru_vdr)) fswthru_vdr(n) = l_fswthru_vdr + if(present(fswthru_vdf)) fswthru_vdf(n) = l_fswthru_vdf + if(present(fswthru_idr)) fswthru_idr(n) = l_fswthru_idr + if(present(fswthru_idf)) fswthru_idf(n) = l_fswthru_idf + endif ! aicen > puny enddo ! ncat - if(present(fswthru_vdr)) fswthru_vdr = l_fswthru_vdr - if(present(fswthru_vdf)) fswthru_vdf = l_fswthru_vdf - if(present(fswthru_idr)) fswthru_idr = l_fswthru_idr - if(present(fswthru_idf)) fswthru_idf = l_fswthru_idf - - deallocate(l_fswthru_vdr) - deallocate(l_fswthru_vdf) - deallocate(l_fswthru_idr) - deallocate(l_fswthru_idf) - end subroutine shortwave_ccsm3 !======================================================================= @@ -879,8 +866,10 @@ subroutine run_dEdd(dt, ncat, & fswthrun_idr, & ! nir dir SW through ice to ocean (W/m^2) fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) + real(kind=dbl_kind), dimension(:,:), intent(inout), optional :: & + rsnow ! snow grain radius tracer (10^-6 m) + real(kind=dbl_kind), dimension(:,:), intent(inout) :: & - rsnow , & ! snow grain radius tracer (10^-6 m) Sswabsn , & ! SW radiation absorbed in snow layers (W m-2) Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) fswpenln ! visible SW entering ice layers (W m-2) @@ -903,6 +892,7 @@ subroutine run_dEdd(dt, ncat, & alvl ! area fraction of level ice real (kind=dbl_kind), dimension (nslyr) :: & + l_rsnow , & ! local array for snow grain radius tracer (10^-6 m) rhosnwn , & ! snow density (kg/m3) rsnwn ! snow grain radius (micrometers) @@ -929,7 +919,7 @@ subroutine run_dEdd(dt, ncat, & logical (kind=log_kind) :: & linitonly ! local initonly value - real (kind=dbl_kind), dimension(:), allocatable :: & + real (kind=dbl_kind) :: & l_fswthrun_vdr , & ! vis dir SW through ice to ocean (W m-2) l_fswthrun_vdf , & ! vis dif SW through ice to ocean (W m-2) l_fswthrun_idr , & ! nir dir SW through ice to ocean (W m-2) @@ -937,16 +927,13 @@ subroutine run_dEdd(dt, ncat, & character(len=*),parameter :: subname='(run_dEdd)' - allocate(l_fswthrun_vdr(ncat)) - allocate(l_fswthrun_vdf(ncat)) - allocate(l_fswthrun_idr(ncat)) - allocate(l_fswthrun_idf(ncat)) - linitonly = .false. if (present(initonly)) then linitonly = initonly endif + l_rsnow = c0 + ! cosine of the zenith angle #ifdef CESMCOUPLED call compute_coszen (tlat, tlon, & @@ -973,13 +960,17 @@ subroutine run_dEdd(dt, ncat, & if (aicen(n) > puny) then + if (present(rsnow)) then + l_rsnow(:) = rsnow(:,n) + endif + call shortwave_dEdd_set_snow(nslyr, R_snw, & dT_mlt, rsnw_mlt, & aicen(n), vsnon(n), & Tsfcn(n), fsn, & hs0, hsn, & rhosnwn, rsnwn, & - rsnow(:,n)) + l_rsnow(:)) if (icepack_warnings_aborted(subname)) return ! set pond properties @@ -1002,7 +993,7 @@ subroutine run_dEdd(dt, ncat, & Tsfcn(n), fsn, & hs0, hsnlvl, & rhosnwn(:), rsnwn(:), & - rsnow(:,n)) + l_rsnow(:)) if (icepack_warnings_aborted(subname)) return endif ! snwredist @@ -1122,10 +1113,10 @@ subroutine run_dEdd(dt, ncat, & alidrn(n), alidfn(n), & fswsfcn(n), fswintn(n), & fswthru=fswthrun(n), & - fswthru_vdr=l_fswthrun_vdr(n), & - fswthru_vdf=l_fswthrun_vdf(n), & - fswthru_idr=l_fswthrun_idr(n), & - fswthru_idf=l_fswthrun_idf(n), & + fswthru_vdr=l_fswthrun_vdr, & + fswthru_vdf=l_fswthrun_vdf, & + fswthru_idr=l_fswthrun_idr, & + fswthru_idf=l_fswthrun_idf, & Sswabs=Sswabsn(:,n), & Iswabs=Iswabsn(:,n), & albice=albicen(n), & @@ -1137,26 +1128,23 @@ subroutine run_dEdd(dt, ncat, & if (icepack_warnings_aborted(subname)) return - if (.not. snwgrain) then - do k = 1,nslyr - rsnow(k,n) = rsnwn(k) ! for history - enddo + if(present(fswthrun_vdr)) fswthrun_vdr(n) = l_fswthrun_vdr + if(present(fswthrun_vdf)) fswthrun_vdf(n) = l_fswthrun_vdf + if(present(fswthrun_idr)) fswthrun_idr(n) = l_fswthrun_idr + if(present(fswthrun_idf)) fswthrun_idf(n) = l_fswthrun_idf + + if (present(rsnow)) then + if (.not. snwgrain) then + do k = 1,nslyr + rsnow(k,n) = rsnwn(k) ! set rsnow for history + enddo + endif endif endif ! aicen > puny enddo ! ncat - if(present(fswthrun_vdr)) fswthrun_vdr = l_fswthrun_vdr - if(present(fswthrun_vdf)) fswthrun_vdf = l_fswthrun_vdf - if(present(fswthrun_idr)) fswthrun_idr = l_fswthrun_idr - if(present(fswthrun_idf)) fswthrun_idf = l_fswthrun_idf - - deallocate(l_fswthrun_vdr) - deallocate(l_fswthrun_vdf) - deallocate(l_fswthrun_idr) - deallocate(l_fswthrun_idf) - end subroutine run_dEdd !======================================================================= @@ -4106,39 +4094,14 @@ subroutine icepack_step_radiation (dt, ncat, & integer (kind=int_kind) :: & n ! thickness category index - logical (kind=log_kind) :: & - linitonly ! local flag for initonly - real(kind=dbl_kind) :: & hin, & ! Ice thickness (m) hbri ! brine thickness (m) - real (kind=dbl_kind), dimension(:), allocatable :: & - l_fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) - l_fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2) - l_fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2) - l_fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) - - real (kind=dbl_kind), dimension(:,:), allocatable :: & - l_rsnow ! snow grain radius tracer (10^-6 m) - character(len=*),parameter :: subname='(icepack_step_radiation)' - allocate(l_fswthrun_vdr(ncat)) - allocate(l_fswthrun_vdf(ncat)) - allocate(l_fswthrun_idr(ncat)) - allocate(l_fswthrun_idf(ncat)) - hin = c0 hbri = c0 - linitonly = .false. - if (present(initonly)) then - linitonly = initonly - endif - - allocate(l_rsnow (nslyr,ncat)) - l_rsnow = c0 - if (present(rsnow)) l_rsnow = rsnow ! Initialize do n = 1, ncat @@ -4175,7 +4138,7 @@ subroutine icepack_step_radiation (dt, ncat, & enddo endif - if (calc_Tsfc) then + if (calc_Tsfc) then if (trim(shortwave) == 'dEdd') then ! delta Eddington call run_dEdd(dt, ncat, & @@ -4209,10 +4172,10 @@ subroutine icepack_step_radiation (dt, ncat, & alidrn, alidfn, & fswsfcn, fswintn, & fswthrun=fswthrun, & - fswthrun_vdr=l_fswthrun_vdr, & - fswthrun_vdf=l_fswthrun_vdf, & - fswthrun_idr=l_fswthrun_idr, & - fswthrun_idf=l_fswthrun_idf, & + fswthrun_vdr=fswthrun_vdr, & + fswthrun_vdf=fswthrun_vdf, & + fswthrun_idr=fswthrun_idr, & + fswthrun_idf=fswthrun_idf, & fswpenln=fswpenln, & Sswabsn=Sswabsn, & Iswabsn=Iswabsn, & @@ -4223,9 +4186,9 @@ subroutine icepack_step_radiation (dt, ncat, & snowfracn=snowfracn, & dhsn=dhsn, & ffracn=ffracn, & - rsnow=l_rsnow, & + rsnow=rsnow, & l_print_point=l_print_point, & - initonly=linitonly) + initonly=initonly) if (icepack_warnings_aborted(subname)) return elseif (trim(shortwave) == 'ccsm3') then @@ -4243,10 +4206,10 @@ subroutine icepack_step_radiation (dt, ncat, & alvdfn, alidfn, & fswsfcn, fswintn, & fswthru=fswthrun, & - fswthru_vdr=l_fswthrun_vdr,& - fswthru_vdf=l_fswthrun_vdf,& - fswthru_idr=l_fswthrun_idr,& - fswthru_idf=l_fswthrun_idf,& + fswthru_vdr=fswthrun_vdr,& + fswthru_vdf=fswthrun_vdf,& + fswthru_idr=fswthrun_idr,& + fswthru_idf=fswthrun_idf,& fswpenl=fswpenln, & Iswabs=Iswabsn, & Sswabs=Sswabsn, & @@ -4300,17 +4263,6 @@ subroutine icepack_step_radiation (dt, ncat, & endif ! calc_Tsfc - if (present(fswthrun_vdr)) fswthrun_vdr = l_fswthrun_vdr - if (present(fswthrun_vdf)) fswthrun_vdf = l_fswthrun_vdf - if (present(fswthrun_idr)) fswthrun_idr = l_fswthrun_idr - if (present(fswthrun_idf)) fswthrun_idf = l_fswthrun_idf - - deallocate(l_fswthrun_vdr) - deallocate(l_fswthrun_vdf) - deallocate(l_fswthrun_idr) - deallocate(l_fswthrun_idf) - deallocate(l_rsnow) - end subroutine icepack_step_radiation !======================================================================= diff --git a/columnphysics/icepack_therm_bl99.F90 b/columnphysics/icepack_therm_bl99.F90 index 7aa553c95..7a090ef91 100644 --- a/columnphysics/icepack_therm_bl99.F90 +++ b/columnphysics/icepack_therm_bl99.F90 @@ -28,7 +28,7 @@ module icepack_therm_bl99 implicit none private - public :: surface_fluxes, temperature_changes + public :: temperature_changes real (kind=dbl_kind), parameter :: & betak = 0.13_dbl_kind, & ! constant in formula for k (W m-1 ppt-1) @@ -79,8 +79,7 @@ subroutine temperature_changes (dt, & real (kind=dbl_kind), intent(in) :: & dt ! time step - real (kind=dbl_kind), & - intent(in) :: & + real (kind=dbl_kind), intent(in) :: & rhoa , & ! air density (kg/m^3) flw , & ! incoming longwave radiation (W/m^2) potT , & ! air potential temperature (K) @@ -89,8 +88,7 @@ subroutine temperature_changes (dt, & lhcoef , & ! transfer coefficient for latent heat Tbot ! ice bottom surface temperature (deg C) - real (kind=dbl_kind), & - intent(inout) :: & + real (kind=dbl_kind), intent(inout) :: & fswsfc , & ! SW absorbed at ice/snow surface (W m-2) fswint ! SW absorbed in ice interior below surface (W m-2) @@ -99,12 +97,10 @@ subroutine temperature_changes (dt, & hslyr , & ! snow layer thickness (m) einit ! initial energy of melting (J m-2) - real (kind=dbl_kind), dimension (nslyr), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nslyr), intent(inout) :: & Sswabs ! SW radiation absorbed in snow layers (W m-2) - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nilyr), intent(inout) :: & Iswabs ! SW radiation absorbed in ice layers (W m-2) real (kind=dbl_kind), intent(inout):: & @@ -117,21 +113,17 @@ subroutine temperature_changes (dt, & real (kind=dbl_kind), intent(out):: & fcondbot ! downward cond flux at bottom surface (W m-2) - real (kind=dbl_kind), & - intent(inout):: & + real (kind=dbl_kind), intent(inout):: & Tsf ! ice/snow surface temperature, Tsfcn - real (kind=dbl_kind), dimension (nilyr), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nilyr), intent(inout) :: & zqin , & ! ice layer enthalpy (J m-3) zTin ! internal ice layer temperatures - real (kind=dbl_kind), dimension (nilyr), & - intent(in) :: & + real (kind=dbl_kind), dimension (nilyr), intent(in) :: & zSin ! internal ice layer salinities - real (kind=dbl_kind), dimension (nslyr), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nslyr), intent(inout) :: & zqsn , & ! snow layer enthalpy (J m-3) zTsn ! internal snow layer temperatures @@ -833,8 +825,7 @@ subroutine conductivity (l_snow, & zTin , & ! internal ice layer temperatures zSin ! internal ice layer salinities - real (kind=dbl_kind), dimension (nilyr+nslyr+1), & - intent(out) :: & + real (kind=dbl_kind), dimension (nilyr+nslyr+1), intent(out) :: & kh ! effective conductivity at interfaces (W m-2 deg-1) ! local variables @@ -937,21 +928,18 @@ subroutine surface_fluxes (Tsf, fswsfc, & shcoef , & ! transfer coefficient for sensible heat lhcoef ! transfer coefficient for latent heat - real (kind=dbl_kind), & - intent(inout) :: & + real (kind=dbl_kind), intent(inout) :: & fsensn , & ! surface downward sensible heat (W m-2) flatn , & ! surface downward latent heat (W m-2) flwoutn , & ! upward LW at surface (W m-2) fsurfn ! net flux to top surface, excluding fcondtopn - real (kind=dbl_kind), & - intent(inout) :: & + real (kind=dbl_kind), intent(inout) :: & dfsens_dT , & ! deriv of fsens wrt Tsf (W m-2 deg-1) dflat_dT , & ! deriv of flat wrt Tsf (W m-2 deg-1) dflwout_dT ! deriv of flwout wrt Tsf (W m-2 deg-1) - real (kind=dbl_kind), & - intent(inout) :: & + real (kind=dbl_kind), intent(inout) :: & dfsurf_dT ! derivative of fsurfn wrt Tsf character(len=*),parameter :: subname='(surface_fluxes)' @@ -1001,8 +989,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & nilyr , & ! number of ice layers nslyr ! number of snow layers - logical (kind=log_kind), & - intent(in) :: & + logical (kind=log_kind), intent(in) :: & l_snow , & ! true if snow temperatures are computed l_cold ! true if surface temperature is computed @@ -1025,12 +1012,10 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & Tsn_init ! snow temp at beginning of time step ! Note: no absorbed SW in snow layers - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(in) :: & + real (kind=dbl_kind), dimension (nslyr+nilyr+1), intent(in) :: & kh ! effective conductivity at layer interfaces - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nslyr+nilyr+1), intent(inout) :: & sbdiag , & ! sub-diagonal matrix elements diag , & ! diagonal matrix elements spdiag , & ! super-diagonal matrix elements @@ -1250,8 +1235,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & nilyr , & ! number of ice layers nslyr ! number of snow layers - logical (kind=log_kind), & - intent(in) :: & + logical (kind=log_kind), intent(in) :: & l_snow ! true if snow temperatures are computed real (kind=dbl_kind), intent(in) :: & @@ -1266,19 +1250,16 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & Tsn_init ! snow temp at beginning of time step ! Note: no absorbed SW in snow layers - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(in) :: & + real (kind=dbl_kind), dimension (nslyr+nilyr+1), intent(in) :: & kh ! effective conductivity at layer interfaces - real (kind=dbl_kind), dimension (nslyr+nilyr+1), & - intent(inout) :: & + real (kind=dbl_kind), dimension (nslyr+nilyr+1), intent(inout) :: & sbdiag , & ! sub-diagonal matrix elements diag , & ! diagonal matrix elements spdiag , & ! super-diagonal matrix elements rhs ! rhs of tri-diagonal matrix eqn. - real (kind=dbl_kind), intent(in), & - optional :: & + real (kind=dbl_kind), intent(in) :: & fcondtopn ! conductive flux at top sfc, positive down (W/m^2) ! local variables diff --git a/columnphysics/icepack_therm_itd.F90 b/columnphysics/icepack_therm_itd.F90 index e4af94abc..93ed8bebd 100644 --- a/columnphysics/icepack_therm_itd.F90 +++ b/columnphysics/icepack_therm_itd.F90 @@ -56,10 +56,7 @@ module icepack_therm_itd implicit none private - public :: linear_itd, & - add_new_ice, & - lateral_melt, & - icepack_step_therm2 + public :: icepack_step_therm2 !======================================================================= diff --git a/columnphysics/icepack_therm_vertical.F90 b/columnphysics/icepack_therm_vertical.F90 index 565e82a59..846cadfcf 100644 --- a/columnphysics/icepack_therm_vertical.F90 +++ b/columnphysics/icepack_therm_vertical.F90 @@ -61,9 +61,7 @@ module icepack_therm_vertical implicit none private - public :: frzmlt_bottom_lateral, & - thermo_vertical, & - icepack_step_therm1 + public :: icepack_step_therm1 !======================================================================= @@ -2396,7 +2394,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & smice , & ! tracer for mass of ice in snow (kg/m^3) smliq ! tracer for mass of liquid in snow (kg/m^3) - real (kind=dbl_kind), allocatable, dimension(:) :: & + real (kind=dbl_kind), dimension(ncat) :: & l_meltsliqn ! mass of snow melt local (kg/m^2) real (kind=dbl_kind) :: & @@ -2457,11 +2455,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & smice(:) = c0 smliq(:) = c0 - allocate(l_meltsliqn(ncat)) - l_meltsliqn = c0 - if (present(meltsliqn)) l_meltsliqn = meltsliqn l_meltsliq = c0 + l_meltsliqn = c0 if (present(meltsliq )) l_meltsliq = meltsliq + if (present(meltsliqn)) l_meltsliqn = meltsliqn !----------------------------------------------------------------- ! Initialize rate of snow loss to leads @@ -2923,7 +2920,6 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & if (present(meltsliqn )) meltsliqn = l_meltsliqn if (present(meltsliq )) meltsliq = l_meltsliq - deallocate(l_meltsliqn) !----------------------------------------------------------------- ! Calculate ponds from the topographic scheme diff --git a/columnphysics/icepack_tracers.F90 b/columnphysics/icepack_tracers.F90 index 9f2f2f77c..c8135dea1 100644 --- a/columnphysics/icepack_tracers.F90 +++ b/columnphysics/icepack_tracers.F90 @@ -907,7 +907,7 @@ end subroutine icepack_query_tracer_indices subroutine icepack_write_tracer_indices(iounit) - integer, intent(in), optional :: iounit + integer, intent(in) :: iounit !autodocument_end