Merge pull request #181 from CICE-Consortium/hobart

Add additional Hobart support and recode functions.
CICE-Consortium · Mar 16, 2018 · d233be2 · d233be2
2 parents 6cd5afd + ef5c3fa
commit d233be2
Show file tree

Hide file tree

Showing 10 changed files with 192 additions and 82 deletions.
diff --git a/columnphysics/icepack_atmo.F90 b/columnphysics/icepack_atmo.F90
@@ -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)
 
       !------------------------------------------------------------
@@ -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

diff --git a/columnphysics/icepack_brine.F90 b/columnphysics/icepack_brine.F90
@@ -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
@@ -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  
@@ -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

diff --git a/columnphysics/icepack_mechred.F90 b/columnphysics/icepack_mechred.F90
@@ -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

diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90
@@ -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, &
@@ -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
@@ -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 
@@ -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
@@ -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
@@ -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
@@ -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

diff --git a/columnphysics/icepack_therm_bl99.F90 b/columnphysics/icepack_therm_bl99.F90
@@ -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

diff --git a/columnphysics/icepack_therm_itd.F90 b/columnphysics/icepack_therm_itd.F90
@@ -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

diff --git a/configuration/scripts/machines/Macros.hobart_intel b/configuration/scripts/machines/Macros.hobart_intel
@@ -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
diff --git a/configuration/scripts/machines/Macros.hobart_nag b/configuration/scripts/machines/Macros.hobart_nag
@@ -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