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.

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

Add additional Hobart support. v1.0.0.d0004 #181

Merged
merged 3 commits into from
Mar 16, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
42 changes: 26 additions & 16 deletions columnphysics/icepack_atmo.F90
Original file line number Diff line number Diff line change
Expand Up @@ -154,24 +154,8 @@ subroutine atmo_boundary_layer (sfctype, &
real (kind=dbl_kind), parameter :: &
zTrf = c2 ! reference height for air temp (m)

! local functions
real (kind=dbl_kind) :: &
xd , & ! dummy argument
psimhu, & ! unstable part of psimh
psixhu ! unstable part of psimx

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

!------------------------------------------------------------
! Define functions
!------------------------------------------------------------

psimhu(xd) = log((c1+xd*(c2+xd))*(c1+xd*xd)/c8) &
- c2*atan(xd) + pih
!ech - c2*atan(xd) + 1.571_dbl_kind

psixhu(xd) = c2 * log((c1 + xd*xd)/c2)

al2 = log(zref/zTrf)

!------------------------------------------------------------
Expand Down Expand Up @@ -929,6 +913,32 @@ subroutine icepack_atm_boundary(sfctype, &

end subroutine icepack_atm_boundary

!------------------------------------------------------------
! Define functions
!------------------------------------------------------------

!=======================================================================

real(kind=dbl_kind) function psimhu(xd)

real(kind=dbl_kind), intent(in) :: xd

psimhu = log((c1+xd*(c2+xd))*(c1+xd*xd)/c8) &
- c2*atan(xd) + pih
!ech - c2*atan(xd) + 1.571_dbl_kind

end function psimhu

!=======================================================================

real(kind=dbl_kind) function psixhu(xd)

real(kind=dbl_kind), intent(in) :: xd

psixhu = c2 * log((c1 + xd*xd)/c2)

end function psixhu

!=======================================================================

end module icepack_atmo
Expand Down
14 changes: 7 additions & 7 deletions columnphysics/icepack_brine.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
module icepack_brine

use icepack_kinds
use icepack_parameters, only: p01, p001, p5, c0, c1, c2, c1p5, c10, puny
use icepack_parameters, only: p01, p001, p5, c0, c1, c2, c1p5, puny
use icepack_parameters, only: gravit, rhoi, rhow, rhos, depressT
use icepack_parameters, only: salt_loss, min_salin, rhosi
use icepack_parameters, only: dts_b, l_sk
Expand Down Expand Up @@ -649,8 +649,8 @@ subroutine compute_microS (n_cat, nilyr, nblyr, &
surface_S , & ! salinity of ice above hin > hbr
hinc_old ! ice thickness (cell quantity) before current melt/growth (m)

logical (kind=log_kind) :: &
Rayleigh ! .true. if ice exceeded a minimum thickness hin >= Ra_c
! logical (kind=log_kind) :: &
! Rayleigh ! .true. if ice exceeded a minimum thickness hin >= Ra_c

real (kind=dbl_kind), dimension (ntrcr+2) :: &
trtmp0 , & ! temporary, remapped tracers
Expand Down Expand Up @@ -681,10 +681,10 @@ subroutine compute_microS (n_cat, nilyr, nblyr, &
! Turn off by putting Ra_c = 0 in ice_in namelist.
!-----------------------------------------------------------------

Rayleigh = .true.
if (n_cat == 1 .AND. hbr_old < Ra_c) then
Rayleigh = Rayleigh_criteria ! only category 1 ice can be false
endif
! Rayleigh = .true.
! if (n_cat == 1 .AND. hbr_old < Ra_c) then
! Rayleigh = Rayleigh_criteria ! only category 1 ice can be false
! endif

!-----------------------------------------------------------------
! Define ice salinity on Sin
Expand Down
2 changes: 1 addition & 1 deletion columnphysics/icepack_mechred.F90
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ 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, rhow
use icepack_parameters, only: puny, Lfresh, rhoi, rhos

use icepack_parameters, only: kstrength, krdg_partic, krdg_redist, mu_rdg
use icepack_parameters, only: heat_capacity
Expand Down
133 changes: 93 additions & 40 deletions columnphysics/icepack_shortwave.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3156,39 +3156,20 @@ subroutine solution_dEdd &
real (kind=dbl_kind) :: &
mu0n ! cosine solar zenith angle in medium

real (kind=dbl_kind) :: &
alpha , & ! term in direct reflectivity and transmissivity
agamm , & ! term in direct reflectivity and transmissivity
el , & ! term in alpha,agamm,n,u
taus , & ! scaled extinction optical depth
omgs , & ! scaled single particle scattering albedo
asys , & ! scaled asymmetry parameter
u , & ! term in diffuse reflectivity and transmissivity
n , & ! term in diffuse reflectivity and transmissivity
lm , & ! temporary for el
mu , & ! cosine solar zenith for either snow or water
ne ! temporary for n

real (kind=dbl_kind) :: &
w , & ! dummy argument for statement function
uu , & ! dummy argument for statement function
gg , & ! dummy argument for statement function
e , & ! dummy argument for statement function
f , & ! dummy argument for statement function
t , & ! dummy argument for statement function
et ! dummy argument for statement function

real (kind=dbl_kind) :: &
alp , & ! temporary for alpha
gam , & ! temporary for agamm
lm , & ! temporary for el
mu , & ! temporary for gauspt
ne , & ! temporary for n
ue , & ! temporary for u
extins , & ! extinction
amg , & ! alp - gam
apg ! alp + gam

integer (kind=int_kind), parameter :: &
ngmax = 8 ! number of gaussian angles in hemisphere

real (kind=dbl_kind), dimension (ngmax), parameter :: &
gauspt & ! gaussian angles (radians)
= (/ .9894009_dbl_kind, .9445750_dbl_kind, &
Expand All @@ -3200,10 +3181,10 @@ subroutine solution_dEdd &
.0951585_dbl_kind, .1246290_dbl_kind, &
.1495960_dbl_kind, .1691565_dbl_kind, &
.1826034_dbl_kind, .1894506_dbl_kind/)

integer (kind=int_kind) :: &
ng ! gaussian integration index

real (kind=dbl_kind) :: &
gwt , & ! gaussian weight
swt , & ! sum of weights
Expand All @@ -3212,22 +3193,12 @@ subroutine solution_dEdd &
tdr , & ! tdir for gaussian integration
smr , & ! accumulator for rdif gaussian integration
smt ! accumulator for tdif gaussian integration

real (kind=dbl_kind) :: &
exp_min ! minimum exponential value

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

! Delta-Eddington solution expressions
alpha(w,uu,gg,e) = p75*w*uu*((c1 + gg*(c1-w))/(c1 - e*e*uu*uu))
agamm(w,uu,gg,e) = p5*w*((c1 + c3*gg*(c1-w)*uu*uu)/(c1-e*e*uu*uu))
n(uu,et) = ((uu+c1)*(uu+c1)/et ) - ((uu-c1)*(uu-c1)*et)
u(w,gg,e) = c1p5*(c1 - w*gg)/e
el(w,gg) = sqrt(c3*(c1-w)*(c1 - w*gg))
taus(w,f,t) = (c1 - w*f)*t
omgs(w,f) = (c1 - f)*w/(c1 - w*f)
asys(gg,f) = (gg - f)/(c1 - f)

!-----------------------------------------------------------------------

do k = 0, klevp
Expand All @@ -3238,7 +3209,7 @@ subroutine solution_dEdd &
rupdif(k) = c0
rdndif(k) = c0
enddo

! initialize top interface of top layer
trndir(0) = c1
trntdr(0) = c1
Expand All @@ -3255,7 +3226,7 @@ subroutine solution_dEdd &
! value below the fresnel level, i.e. the cosine solar zenith
! angle below the fresnel level for the refracted solar beam:
mu0nij = sqrt(c1-((c1-mu0**2)/(refindx*refindx)))

! compute level of fresnel refraction
! if ponded sea ice, fresnel level is the top of the pond.
kfrsnl = 0
Expand All @@ -3271,7 +3242,7 @@ subroutine solution_dEdd &

! begin main level loop
do k = 0, klev

! initialize all layer apparent optical properties to 0
rdir (k) = c0
rdif_a(k) = c0
Expand Down Expand Up @@ -4194,6 +4165,88 @@ subroutine icepack_step_radiation (dt, ncat, &

end subroutine icepack_step_radiation

! Delta-Eddington solution expressions

!=======================================================================

real(kind=dbl_kind) function alpha(w,uu,gg,e)

real(kind=dbl_kind), intent(in) :: w, uu, gg, e

alpha = p75*w*uu*((c1 + gg*(c1-w))/(c1 - e*e*uu*uu))

end function alpha

!=======================================================================

real(kind=dbl_kind) function agamm(w,uu,gg,e)

real(kind=dbl_kind), intent(in) :: w, uu, gg, e

agamm = p5*w*((c1 + c3*gg*(c1-w)*uu*uu)/(c1-e*e*uu*uu))

end function agamm

!=======================================================================

real(kind=dbl_kind) function n(uu,et)

real(kind=dbl_kind), intent(in) :: uu, et

n = ((uu+c1)*(uu+c1)/et ) - ((uu-c1)*(uu-c1)*et)

end function n

!=======================================================================

real(kind=dbl_kind) function u(w,gg,e)

real(kind=dbl_kind), intent(in) :: w, gg, e

u = c1p5*(c1 - w*gg)/e

end function u

!=======================================================================

real(kind=dbl_kind) function el(w,gg)

real(kind=dbl_kind), intent(in) :: w, gg

el = sqrt(c3*(c1-w)*(c1 - w*gg))

end function el

!=======================================================================

real(kind=dbl_kind) function taus(w,f,t)

real(kind=dbl_kind), intent(in) :: w, f, t

taus = (c1 - w*f)*t

end function taus

!=======================================================================

real(kind=dbl_kind) function omgs(w,f)

real(kind=dbl_kind), intent(in) :: w, f

omgs = (c1 - f)*w/(c1 - w*f)

end function omgs

!=======================================================================

real(kind=dbl_kind) function asys(gg,f)

real(kind=dbl_kind), intent(in) :: gg, f

asys = (gg - f)/(c1 - f)

end function asys

!=======================================================================

end module icepack_shortwave
Expand Down
5 changes: 4 additions & 1 deletion columnphysics/icepack_therm_bl99.F90
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,10 @@
module icepack_therm_bl99

use icepack_kinds
use icepack_parameters, only: c0, c1, c2, p01, p1, p5, puny
use icepack_parameters, only: c0, c1, c2, p1, p5, puny
#ifdef CESMCOUPLED
use icepack_parameters, only p01
#endif
use icepack_parameters, only: rhoi, rhos, hs_min, cp_ice, cp_ocn, depressT, Lfresh, ksno, kice
use icepack_parameters, only: conduct, calc_Tsfc, solve_zsal
use icepack_warnings, only: warnstr, icepack_warnings_add
Expand Down
2 changes: 1 addition & 1 deletion columnphysics/icepack_therm_itd.F90
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ module icepack_therm_itd
use icepack_parameters, only: phi_init, dsin0_frazil, hs_ssl, salt_loss
use icepack_parameters, only: rhosi
use icepack_parameters, only: kitd, ktherm, heat_capacity
use icepack_parameters, only: z_tracers, solve_zsal, initbio_frac
use icepack_parameters, only: z_tracers, solve_zsal

use icepack_tracers, only: ntrcr, nbtrcr
use icepack_tracers, only: nt_qice, nt_qsno, nt_fbri, nt_sice
Expand Down
33 changes: 33 additions & 0 deletions configuration/scripts/machines/Macros.hobart_intel
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
#==============================================================================
# Makefile macros for NCAR cheyenne, intel compiler
#==============================================================================

CPP := fpp
CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 -DHAVE_F2008_CONTIGUOUS -DLINUX -DCPRINTEL ${ICE_CPPDEFS}
CFLAGS := -qno-opt-dynamic-align -fp-model precise -std=gnu99

FIXEDFLAGS := -fixed -132
FREEFLAGS := -free
FFLAGS := -qno-opt-dynamic-align -convert big_endian -assume byterecl -ftz -traceback -assume realloc_lhs -fp-model source -lifcore
FFLAGS_NOOPT:= -O0
FC_AUTO_R8 := -r8

ifeq ($(ICE_BLDDEBUG), true)
FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created
else
FFLAGS += -O2 -debug minimal
endif

ifeq ($(ICE_COMMDIR), mpi)
FC := mpif90
LD := mpif90
else
FC := ifort
LD := ifort
endif

SLIBS := -Wl,-rpath,/usr/local/intel-cluster-15.0.2.164/composer_xe_2015.2.164/compiler/lib/intel64 -lifcore

ifeq ($(DITTO), yes)
CPPDEFS := $(CPPDEFS) -DREPRODUCIBLE
endif
25 changes: 10 additions & 15 deletions configuration/scripts/machines/Macros.hobart_nag
Original file line number Diff line number Diff line change
Expand Up @@ -7,33 +7,28 @@ CPPFLAGS := -P -traditional
CPPDEFS := -DFORTRANUNDERSCORE -DNO_CRAY_POINTERS -DNO_SHR_VMATH -DCPRNAG
CFLAGS := -std=gnu99

FIXEDFLAGS :=
FREEFLAGS :=
FFLAGS := -Wp,-macro=no_com -convert=BIG_ENDIAN -ieee=full -O2
FFLAGS_NOOPT:=
FIXEDFLAGS := -fixed
FREEFLAGS := -free
FFLAGS := -Wp,-macro=no_com -convert=BIG_ENDIAN -ieee=full -O2 -gline
FFLAGS_NOOPT:= -Wp,-macro=no_com -convert=BIG_ENDIAN -ieee=full -gline
FC_AUTO_R8 := -r8

ifeq ($(ICE_BLDDEBUG), true)
FFLAGS := -C=all -g -time -f2003 -ieee=stop
FFLAGS := -C=all -g -gline -time -f2003 -ieee=stop
endif

ifeq ($(ICE_COMMDIR), mpi)
FC := nagfor
FC := mpif90
LD := mpif90
else
FC := nagfor
LD := nagfor
endif

NETCDF_PATH := /usr/local/netcdf_c-4.3.2_f-4.4.1-nag-6.1

INCLDIR := -I/usr/local/netcdf_c-4.3.2_f-4.4.1-nag-6.1/include

LIB_NETCDF := $(NETCDF_PATH)/lib

SLIBS := -L/usr/local/nag-6.1/lib/NAG_Fortran -lf61rts -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L/cluster/mvapich2-2.2rc1-gcc-g++-4.8.5-nag-6.1/lib -lmpich -lm -lc
SLIBS := -L/usr/local/nag-6.2/lib/NAG_Fortran

ifeq ($(DITTO), yes)
CPPDEFS := $(CPPDEFS) -DREPRODUCIBLE
endif

ifeq ($(IO_TYPE), netcdf)
CPPDEFS := $(CPPDEFS) -Dncdf
endif
Loading