diff --git a/cicecore/drivers/unittest/optargs/optargs.F90 b/cicecore/drivers/unittest/optargs/optargs.F90
index 4acf7ac9f..5d66539b9 100644
--- a/cicecore/drivers/unittest/optargs/optargs.F90
+++ b/cicecore/drivers/unittest/optargs/optargs.F90
@@ -1,45 +1,52 @@
program optargs
- use optargs_subs, only: computeA, computeB, computeC, computeD
- use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D
+ use optargs_subs, only: dp
+ use optargs_subs, only: computeA, computeB, computeC, computeD, computeE
+ use optargs_subs, only: oa_error, oa_OK, oa_A, oa_B, oa_C, oa_D, oa_E
use optargs_subs, only: oa_layer1, oa_count1
implicit none
- real*8 :: Ai1, Ao
- real*8 :: B
- real*8 :: Ci1, Co
- real*8 :: Di1, Di2, Do
+ real(dp):: Ai1, Ao
+ real(dp):: B
+ real(dp):: Ci1, Co
+ real(dp):: Di1, Di2, Do
+ real(dp), allocatable :: Ei(:),Eo(:)
integer :: ierr, ierrV
integer :: n
integer, parameter :: ntests = 100
integer :: iresult
- real*8 :: result, resultV
- real*8, parameter :: errtol = 1.0e-12
+ real(dp):: result, resultV
+ real(dp), parameter :: dpic = -99._dp
+ real(dp), parameter :: errtol = 1.0e-12
!----------------------
write(6,*) 'RunningUnitTest optargs'
write(6,*) ' '
+ allocate(Ei(3),Eo(3))
+
iresult = 0
do n = 1,ntests
- Ai1 = -99.; Ao = -99.
- B = -99.
- Ci1 = -99.; Co = -99.
- Di1 = -99.; Di2 = -99.; Do = -99.
+ Ai1 = dpic; Ao = dpic
+ B = dpic
+ Ci1 = dpic; Co = dpic
+ Di1 = dpic; Di2 = dpic; Do = dpic
+ Ei = dpic; Eo = dpic
ierr = oa_error
- result = -888.
- resultV = -999.
+ result = -888._dp
+ resultV = -999._dp
computeA = .false.
computeB = .false.
computeC = .false.
computeD = .false.
+ computeE = .false.
select case (n)
@@ -56,8 +63,8 @@ program optargs
call oa_count1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
case(2)
result = -777.; resultV = -777.
- ierrV = 9
- call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ ierrV = 11
+ call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
case(3)
result = -777.; resultV = -777.
ierrV = 3
@@ -66,6 +73,10 @@ program optargs
result = -777.; resultV = -777.
ierrV = 5
call oa_count1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1)
+ case(5)
+ result = -777.; resultV = -777.
+ ierrV = 8
+ call oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,ierr=ierr)
! test optional order
case(11)
@@ -80,6 +91,10 @@ program optargs
result = -777.; resultV = -777.
ierrV = oa_OK
call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1)
+ case(14)
+ result = -777.; resultV = -777.
+ ierrV = oa_OK
+ call oa_layer1(Eo=Eo,Ei=Ei,Ci1=Ci1,Co=Co,ierr=ierr,Ao=Ao,Di1=Di1)
! test optional argument checking
case(21)
@@ -87,15 +102,17 @@ program optargs
computeB = .true.
computeC = .true.
computeD = .true.
+ computeE = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! B missing
- call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
+ call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr)
case(22)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
+ computeE = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! all optional missing
@@ -105,61 +122,117 @@ program optargs
computeB = .true.
computeC = .true.
computeD = .true.
+ computeE = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! some optional missing
- call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr,B=B,Ao=Ao,Di1=Di1)
+ call oa_layer1(Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr,B=B,Ao=Ao,Di1=Di1)
case(24)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
+ computeE = .true.
result = -777.; resultV = -777.
ierrV = oa_error
! one optional missing
- call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,ierr=ierr)
+ call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr)
+ case(25)
+ computeA = .true.
+ computeB = .true.
+ computeC = .true.
+ computeD = .true.
+ computeE = .true.
+ result = -777.; resultV = -777.
+ ierrV = oa_error
+ ! Ei missing
+ call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Eo=Eo,ierr=ierr)
- ! test computations individually
+ ! test computations individually, all args
case(31)
computeA = .true.
ierrV = oa_A
Ai1 = 5.
resultV = 4.
- call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
+ call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr)
result = Ao
case(32)
computeB = .true.
ierrV = oa_B
B = 15.
resultV = 20.
- call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do)
+ call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo)
result = B
case(33)
computeC = .true.
ierrV = oa_C
Ci1 = 7.
resultV = 14.
- call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr)
+ call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr,Ei=Ei,Eo=Eo)
result = Co
case(34)
computeD = .true.
ierrV = oa_D
Di1 = 19; Di2=11.
resultV = 30.
- call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr)
+ call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Ei=Ei,Eo=Eo,Di2=Di2,Do=Do,B=B,ierr=ierr)
result = Do
+ case(35)
+ computeE = .true.
+ ierrV = oa_E
+ Ei = 25.
+ resultV = 81.
+ call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr)
+ result = sum(Eo)
- ! test computations individually
+ ! test computations individually, min args
case(41)
+ computeA = .true.
+ ierrV = oa_A
+ Ai1 = 5.
+ resultV = 4.
+ call oa_layer1(Ao=Ao,Co=Co,Ai1=Ai1,Ci1=Ci1,ierr=ierr)
+ result = Ao
+ case(42)
+ computeB = .true.
+ ierrV = oa_B
+ B = 15.
+ resultV = 20.
+ call oa_layer1(ierr=ierr,Ci1=Ci1,Co=Co,B=B)
+ result = B
+ case(43)
+ computeC = .true.
+ ierrV = oa_C
+ Ci1 = 7.
+ resultV = 14.
+ call oa_layer1(Ci1=Ci1,Co=Co,ierr=ierr)
+ result = Co
+ case(44)
+ computeD = .true.
+ ierrV = oa_D
+ Di1 = 19; Di2=11.
+ resultV = 30.
+ call oa_layer1(Ci1=Ci1,Di1=Di1,Di2=Di2,Co=Co,Do=Do,ierr=ierr)
+ result = Do
+ case(45)
+ computeE = .true.
+ ierrV = oa_E
+ Ei = 25.
+ resultV = 81.
+ call oa_layer1(Ci1=Ci1,Co=Co,Ei=Ei,Eo=Eo,ierr=ierr)
+ result = sum(Eo)
+
+ ! test computations in groups, mix of passed arguments
+ case(51)
computeA = .true.
computeC = .true.
ierrV = oa_A + oa_C
Ai1 = 6.
Ci1 = 8.
resultV = 21.
- call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,ierr=ierr)
+ call oa_layer1(Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Eo=Eo,ierr=ierr)
result = Ao + Co
- case(42)
+ case(52)
computeB = .true.
computeC = .true.
ierrV = oa_B + oa_C
@@ -168,7 +241,7 @@ program optargs
resultV = -11.
call oa_layer1(ierr=ierr,Ai1=Ai1,Ao=Ao,B=B,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do)
result = B + Co
- case(43)
+ case(53)
computeB = .true.
computeD = .true.
ierrV = oa_B + oa_D
@@ -177,7 +250,7 @@ program optargs
resultV = 31.
call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,ierr=ierr)
result = B + Do
- case(44)
+ case(54)
computeC = .true.
computeD = .true.
ierrV = oa_C + oa_D
@@ -186,20 +259,22 @@ program optargs
resultV = 27.
call oa_layer1(Ai1=Ai1,Ao=Ao,Ci1=Ci1,Co=Co,Di1=Di1,Di2=Di2,Do=Do,B=B,ierr=ierr)
result = Co + Do
- case(45)
+ case(55)
computeA = .true.
computeB = .true.
computeC = .true.
computeD = .true.
- ierrV = oa_A + oa_B + oa_C + oa_D
+ computeE = .true.
+ ierrV = oa_A + oa_B + oa_C + oa_D + oa_E
Ai1 = 7.
B = 9.
Ci1 = 7.
Di1 = 12; Di2=3.
- resultV = 49.
- call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr)
- result = Ao + B + Co + Do
- case(46)
+ Ei = 5
+ resultV = 70.
+ call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,Ei=Ei,Eo=Eo,ierr=ierr)
+ result = Ao + B + Co + Do + sum(Eo)
+ case(56)
computeA = .true.
computeB = .true.
computeD = .true.
@@ -210,6 +285,15 @@ program optargs
resultV = 40.
call oa_layer1(Ao=Ao,B=B,Co=Co,Do=Do,Ai1=Ai1,Ci1=Ci1,Di1=Di1,Di2=Di2,ierr=ierr)
result = Ao + B + Do
+ case(57)
+ computeB = .true.
+ computeE = .true.
+ ierrV = oa_B + oa_E
+ B = 4.
+ Ei = 8.
+ resultV = 39.
+ call oa_layer1(B=B,Ci1=Ci1,Co=Co,Di1=Di1,Ai1=Ai1,Ao=Ao,Di2=Di2,Do=Do,Ei=Ei,Eo=Eo,ierr=ierr)
+ result = B + sum(Eo)
case DEFAULT
ierr = -1234
@@ -219,10 +303,10 @@ program optargs
! skip -1234
if (ierr /= -1234) then
if (ierr == ierrV .and. abs(result-resultV) < errtol ) then
- write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do
+ write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo)
! write(6,101) 'PASS','optarg test',n,ierr,ierrV,result,resultV
else
- write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do
+ write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV,Ao,B,Co,Do,sum(Eo)
! write(6,101) 'FAIL','optarg test',n,ierr,ierrV,result,resultV
iresult = 1
endif
@@ -230,7 +314,7 @@ program optargs
enddo
- 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,6g11.4)
+ 101 format(1x,a,1x,a,1x,i2.2,2i6,3x,8g11.4)
write(6,*) ' '
write(6,*) 'optargs COMPLETED SUCCESSFULLY'
diff --git a/cicecore/drivers/unittest/optargs/optargs_subs.F90 b/cicecore/drivers/unittest/optargs/optargs_subs.F90
index 7469d6800..4269ed23b 100644
--- a/cicecore/drivers/unittest/optargs/optargs_subs.F90
+++ b/cicecore/drivers/unittest/optargs/optargs_subs.F90
@@ -4,17 +4,21 @@ module optargs_subs
implicit none
private
+ integer, public, parameter :: dp = kind(1.d0)
+
logical, public :: computeA = .false., &
computeB = .false., &
computeC = .false., &
- computeD = .false.
+ computeD = .false., &
+ computeE = .false.
integer, public :: oa_error = -99, &
oa_OK = 0, &
oa_A = 1, &
oa_B = 2, &
oa_C = 4, &
- oa_D = 8
+ oa_D = 8, &
+ oa_E = 16
public :: oa_layer1, oa_count1
@@ -22,16 +26,18 @@ module optargs_subs
CONTAINS
!-----------------------------------
- subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ subroutine oa_count1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
- real*8 , intent(in) , optional :: Ai1, Di1, Di2
- real*8 , intent(out) , optional :: Ao, Do
- real*8 , intent(inout), optional :: B
- real*8 , intent(in) :: Ci1
- real*8 , intent(out) :: Co
- integer, intent(inout) :: ierr
+ real(dp), intent(in) , optional :: Ai1, Di1, Di2
+ real(dp), intent(out) , optional :: Ao, Do
+ real(dp), intent(inout), optional :: B
+ real(dp), intent(in) :: Ci1
+ real(dp), intent(out) :: Co
+ real(dp), intent(in) , optional, dimension(:) :: Ei
+ real(dp), intent(out) , optional, dimension(:) :: Eo
+ integer , intent(inout) :: ierr
- call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ call oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
! write(6,*) 'debug oa_count1 ',ierr
@@ -39,14 +45,16 @@ end subroutine oa_count1
!-----------------------------------
- subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
- real*8 , intent(in) , optional :: Ai1, Di1, Di2
- real*8 , intent(out) , optional :: Ao, Do
- real*8 , intent(inout), optional :: B
- real*8 , intent(in) :: Ci1
- real*8 , intent(out) :: Co
- integer, intent(inout) :: ierr
+ real(dp), intent(in) , optional :: Ai1, Di1, Di2
+ real(dp), intent(out) , optional :: Ao, Do
+ real(dp), intent(inout), optional :: B
+ real(dp), intent(in) :: Ci1
+ real(dp), intent(out) :: Co
+ real(dp), intent(in) , optional, dimension(:) :: Ei
+ real(dp), intent(out) , optional, dimension(:) :: Eo
+ integer , intent(inout) :: ierr
ierr = 3 ! Ci1, Co, ierr have to be passed
if (present(Ai1)) ierr = ierr + 1
@@ -55,6 +63,8 @@ subroutine oa_count2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
if (present(Di1)) ierr = ierr + 1
if (present(Di2)) ierr = ierr + 1
if (present(Do) ) ierr = ierr + 1
+ if (present(Ei) ) ierr = ierr + 1
+ if (present(Eo) ) ierr = ierr + 1
! write(6,*) 'debug oa_count2 ',ierr
@@ -62,14 +72,16 @@ end subroutine oa_count2
!-----------------------------------
- subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
- real*8 , intent(in) , optional :: Ai1, Di1, Di2
- real*8 , intent(out) , optional :: Ao, Do
- real*8 , intent(inout), optional :: B
- real*8 , intent(in) :: Ci1
- real*8 , intent(out) :: Co
- integer, intent(inout) :: ierr
+ real(dp), intent(in) , optional :: Ai1, Di1, Di2
+ real(dp), intent(out) , optional :: Ao, Do
+ real(dp), intent(inout), optional :: B
+ real(dp), intent(in) :: Ci1
+ real(dp), intent(out) :: Co
+ real(dp), intent(in) , optional, dimension(:) :: Ei
+ real(dp), intent(out) , optional, dimension(:) :: Eo
+ integer , intent(inout) :: ierr
ierr = oa_OK
if (computeA) then
@@ -87,38 +99,55 @@ subroutine oa_layer1(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
ierr = oa_error
endif
endif
+ if (computeE) then
+ if (.not.(present(Ei).and.present(Eo))) then
+ ierr = oa_error
+ endif
+ endif
if (ierr == oa_OK) then
- call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ call oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
endif
end subroutine oa_layer1
!-----------------------------------
- subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ subroutine oa_layer2(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
+
+! Note: optional arrays must have an optional attribute, otherwise they seg fault
+! Scalars do not seem to have this problem
- real*8 , intent(in) , optional :: Ai1, Di1, Di2
- real*8 , intent(out) , optional :: Ao, Do
- real*8 , intent(inout), optional :: B
- real*8 , intent(in) :: Ci1
- real*8 , intent(out) :: Co
- integer, intent(inout) :: ierr
+ real(dp), intent(in) :: Ai1, Di1, Di2
+ real(dp), intent(out) :: Ao, Do
+ real(dp), intent(inout) :: B
+ real(dp), intent(in) :: Ci1
+ real(dp), intent(out) :: Co
+ real(dp), intent(in) , optional, dimension(:) :: Ei
+ real(dp), intent(out) , optional, dimension(:) :: Eo
+ integer , intent(inout) :: ierr
- call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ call oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
end subroutine oa_layer2
!-----------------------------------
- subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
+ subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,Ei,Eo,ierr)
- real*8 , intent(in) , optional :: Ai1, Di1, Di2
- real*8 , intent(out) , optional :: Ao, Do
- real*8 , intent(inout), optional :: B
- real*8 , intent(in) :: Ci1
- real*8 , intent(out) :: Co
- integer, intent(inout) :: ierr
+! Note: optional arrays must have an optional attribute, otherwise they seg fault
+! Scalars do not seem to have this problem
+
+ real(dp), intent(in) :: Ai1, Di1, Di2
+ real(dp), intent(out) :: Ao, Do
+ real(dp), intent(inout) :: B
+ real(dp), intent(in) :: Ci1
+ real(dp), intent(out) :: Co
+ real(dp), intent(in) , optional, dimension(:) :: Ei
+ real(dp), intent(out) , optional, dimension(:) :: Eo
+ integer , intent(inout) :: ierr
+
+ integer :: n
if (computeA) then
Ao = Ai1 - 1.
@@ -140,6 +169,13 @@ subroutine oa_compute(Ai1,Ao,B,Ci1,Co,Di1,Di2,Do,ierr)
ierr = ierr + oa_D
endif
+ if (computeE) then
+ ierr = ierr + oa_E
+ do n = 1,size(Eo)
+ Eo(n) = Ei(n) + n
+ enddo
+ endif
+
return
end subroutine oa_compute
diff --git a/cicecore/drivers/unittest/opticep/CICE.F90 b/cicecore/drivers/unittest/opticep/CICE.F90
new file mode 100644
index 000000000..79dd06fca
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/CICE.F90
@@ -0,0 +1,59 @@
+!=======================================================================
+! Copyright (c) 2022, Triad National Security, LLC
+! All rights reserved.
+!
+! Copyright 2022. Triad National Security, LLC. This software was
+! produced under U.S. Government contract DE-AC52-06NA25396 for Los
+! Alamos National Laboratory (LANL), which is operated by Triad
+! National Security, LLC for the U.S. Department of Energy. The U.S.
+! Government has rights to use, reproduce, and distribute this software.
+! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY
+! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF
+! THIS SOFTWARE. If software is modified to produce derivative works,
+! such modified software should be clearly marked, so as not to confuse
+! it with the version available from LANL.
+!
+! The full license and distribution policy are available from
+! https://github.com/CICE-Consortium
+!
+!=======================================================================
+!
+! Main driver routine for CICE. Initializes and steps through the model.
+! This program should be compiled if CICE is run as a separate executable,
+! but not if CICE subroutines are called from another program (e.g., CAM).
+!
+! authors Elizabeth C. Hunke and William H. Lipscomb, LANL
+!
+! 2006: Converted to free form source (F90) by Elizabeth Hunke
+! 2008: E. Hunke moved ESMF code to its own driver
+!
+ program icemodel
+
+ use CICE_InitMod
+ use CICE_RunMod
+ use CICE_FinalMod
+
+ implicit none
+ character(len=*), parameter :: subname='(icemodel)'
+
+ !-----------------------------------------------------------------
+ ! Initialize CICE
+ !-----------------------------------------------------------------
+
+ call CICE_Initialize
+
+ !-----------------------------------------------------------------
+ ! Run CICE
+ !-----------------------------------------------------------------
+
+ call CICE_Run
+
+ !-----------------------------------------------------------------
+ ! Finalize CICE
+ !-----------------------------------------------------------------
+
+ call CICE_Finalize
+
+ end program icemodel
+
+!=======================================================================
diff --git a/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90
new file mode 100644
index 000000000..02494bd9c
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/CICE_FinalMod.F90
@@ -0,0 +1,71 @@
+!=======================================================================
+!
+! This module contains routines for the final exit of the CICE model,
+! including final output and clean exit from any message passing
+! environments and frameworks.
+!
+! authors: Philip W. Jones, LANL
+! 2006: Converted to free source form (F90) by Elizabeth Hunke
+! 2008: E. Hunke moved ESMF code to its own driver
+
+ module CICE_FinalMod
+
+ use ice_kinds_mod
+ use ice_communicate, only: my_task, master_task
+ use ice_exit, only: end_run, abort_ice
+ use ice_fileunits, only: nu_diag, release_all_fileunits
+ use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
+
+ implicit none
+ private
+ public :: CICE_Finalize
+
+!=======================================================================
+
+ contains
+
+!=======================================================================
+!
+! This routine shuts down CICE by exiting all relevent environments.
+
+ subroutine CICE_Finalize
+
+ use ice_timers, only: ice_timer_stop, ice_timer_print_all, timer_total, &
+ timer_stats
+
+ character(len=*), parameter :: subname = '(CICE_Finalize)'
+
+ !-------------------------------------------------------------------
+ ! stop timers and print timer info
+ !-------------------------------------------------------------------
+
+ call ice_timer_stop(timer_total) ! stop timing entire run
+ call ice_timer_print_all(stats=timer_stats) ! print timing information
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ if (my_task == master_task) then
+ write(nu_diag, *) " "
+ write(nu_diag, *) "CICE COMPLETED SUCCESSFULLY "
+ write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY "
+ write(nu_diag, *) " "
+ endif
+
+!echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output
+ call release_all_fileunits
+
+ !-------------------------------------------------------------------
+ ! quit MPI
+ !-------------------------------------------------------------------
+
+ call end_run ! quit MPI
+
+ end subroutine CICE_Finalize
+
+!=======================================================================
+
+ end module CICE_FinalMod
+
+!=======================================================================
diff --git a/cicecore/drivers/unittest/opticep/CICE_InitMod.F90 b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90
new file mode 100644
index 000000000..0371c7f38
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/CICE_InitMod.F90
@@ -0,0 +1,517 @@
+!=======================================================================
+!
+! This module contains the CICE initialization routine that sets model
+! parameters and initializes the grid and CICE state variables.
+!
+! authors Elizabeth C. Hunke, LANL
+! William H. Lipscomb, LANL
+! Philip W. Jones, LANL
+!
+! 2006: Converted to free form source (F90) by Elizabeth Hunke
+! 2008: E. Hunke moved ESMF code to its own driver
+
+ module CICE_InitMod
+
+ use ice_kinds_mod
+ use ice_exit, only: abort_ice
+ use ice_fileunits, only: init_fileunits, nu_diag
+ use ice_memusage, only: ice_memusage_init, ice_memusage_print
+ use icepack_intfc, only: icepack_aggregate
+ use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist
+ use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave
+ use icepack_intfc, only: icepack_init_snow
+ use icepack_intfc, only: icepack_configure
+ use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
+ use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, &
+ icepack_query_tracer_indices, icepack_query_tracer_sizes
+
+ implicit none
+ private
+ public :: CICE_Initialize, cice_init
+
+!=======================================================================
+
+ contains
+
+!=======================================================================
+
+! Initialize the basic state, grid and all necessary parameters for
+! running the CICE model. Return the initial state in routine
+! export state.
+! Note: This initialization driver is designed for standalone and
+! CESM-coupled applications. For other
+! applications (e.g., standalone CAM), this driver would be
+! replaced by a different driver that calls subroutine cice_init,
+! where most of the work is done.
+
+ subroutine CICE_Initialize
+
+ character(len=*), parameter :: subname='(CICE_Initialize)'
+ !--------------------------------------------------------------------
+ ! model initialization
+ !--------------------------------------------------------------------
+
+ call cice_init
+
+ end subroutine CICE_Initialize
+
+!=======================================================================
+!
+! Initialize CICE model.
+
+ subroutine cice_init
+
+ use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column
+ use ice_arrays_column, only: floe_rad_l, floe_rad_c, &
+ floe_binwidth, c_fsd_range
+ use ice_state, only: alloc_state
+ use ice_flux_bgc, only: alloc_flux_bgc
+ use ice_calendar, only: dt, dt_dyn, write_ic, &
+ init_calendar, advance_timestep, calc_timesteps
+ use ice_communicate, only: init_communicate, my_task, master_task
+ use ice_diagnostics, only: init_diags
+ use ice_domain, only: init_domain_blocks
+ use ice_domain_size, only: ncat, nfsd
+ use ice_dyn_eap, only: init_eap
+ use ice_dyn_evp, only: init_evp
+ use ice_dyn_vp, only: init_vp
+ use ice_dyn_shared, only: kdyn
+ use ice_flux, only: init_coupler_flux, init_history_therm, &
+ init_history_dyn, init_flux_atm, init_flux_ocn, alloc_flux
+ use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, &
+ get_forcing_atmo, get_forcing_ocn, get_wave_spec, init_snowtable
+ use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, &
+ faero_default, faero_optics, alloc_forcing_bgc, fiso_default
+ use ice_grid, only: init_grid1, init_grid2, alloc_grid
+ use ice_history, only: init_hist, accum_hist
+ use ice_restart_shared, only: restart, runtype
+ use ice_init, only: input_data, init_state
+ use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers
+ use ice_kinds_mod
+ use ice_restoring, only: ice_HaloRestore_init
+ use ice_timers, only: timer_total, init_ice_timers, ice_timer_start
+ use ice_transport_driver, only: init_transport
+
+ logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, &
+ tr_iso, tr_fsd, wave_spec, tr_snow
+ character(len=char_len) :: snw_aging_table
+ character(len=*), parameter :: subname = '(cice_init)'
+
+ call init_communicate ! initial setup for message passing
+ call init_fileunits ! unit numbers
+
+ ! tcx debug, this will create a different logfile for each pe
+ ! if (my_task /= master_task) nu_diag = 100+my_task
+
+ call icepack_configure() ! initialize icepack
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(trim(subname), &
+ file=__FILE__,line= __LINE__)
+
+ call input_data ! namelist variables
+ call input_zbgc ! vertical biogeochemistry namelist
+ call count_tracers ! count tracers
+
+ ! Call this as early as possible, must be after memory_stats is read
+ if (my_task == master_task) then
+ call ice_memusage_init(nu_diag)
+ call ice_memusage_print(nu_diag,subname//':start')
+ endif
+
+ call init_domain_blocks ! set up block decomposition
+ call init_grid1 ! domain distribution
+ call alloc_grid ! allocate grid arrays
+ call alloc_arrays_column ! allocate column arrays
+ call alloc_state ! allocate state arrays
+ call alloc_flux_bgc ! allocate flux_bgc arrays
+ call alloc_flux ! allocate flux arrays
+ call init_ice_timers ! initialize all timers
+ call ice_timer_start(timer_total) ! start timing entire run
+ call init_grid2 ! grid variables
+ call init_zbgc ! vertical biogeochemistry initialization
+ call init_calendar ! initialize some calendar stuff
+ call init_hist (dt) ! initialize output history file
+
+ if (kdyn == 1) then
+ call init_evp
+ else if (kdyn == 2) then
+ call init_eap ! define eap dynamics parameters, variables
+ else if (kdyn == 3) then
+ call init_vp ! define vp dynamics parameters, variables
+ endif
+
+ call init_coupler_flux ! initialize fluxes exchanged with coupler
+
+ call init_thermo_vertical ! initialize vertical thermodynamics
+
+ call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution
+ if (my_task == master_task) then
+ call icepack_init_itd_hist(ncat=ncat, hin_max=hin_max, c_hi_range=c_hi_range) ! output
+ endif
+
+ call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(trim(subname), &
+ file=__FILE__,line= __LINE__)
+
+ if (tr_fsd) call icepack_init_fsd_bounds (nfsd, & ! floe size distribution
+ floe_rad_l, & ! fsd size lower bound in m (radius)
+ floe_rad_c, & ! fsd size bin centre in m (radius)
+ floe_binwidth, & ! fsd size bin width in m (radius)
+ c_fsd_range, & ! string for history output
+ write_diags=(my_task == master_task)) ! write diag on master only
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call init_forcing_ocn(dt) ! initialize sss and sst from data
+ call init_state ! initialize the ice state
+ call init_transport ! initialize horizontal transport
+ call ice_HaloRestore_init ! restored boundary conditions
+
+ call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, &
+ wave_spec_out=wave_spec, snw_aging_table_out=snw_aging_table)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(trim(subname), &
+ file=__FILE__,line= __LINE__)
+
+ if (skl_bgc .or. z_tracers) call alloc_forcing_bgc ! allocate biogeochemistry arrays
+
+ call init_restart ! initialize restart variables
+ call init_diags ! initialize diagnostic output points
+ call init_history_therm ! initialize thermo history variables
+ call init_history_dyn ! initialize dynamic history variables
+ call calc_timesteps ! update timestep counter if not using npt_unit="1"
+
+ call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero)
+ call icepack_query_tracer_flags(tr_iso_out=tr_iso, tr_snow_out=tr_snow)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(trim(subname), &
+ file=__FILE__,line= __LINE__)
+
+ if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical
+ !property tables
+
+ ! Initialize shortwave components using swdn from previous timestep
+ ! if restarting. These components will be scaled to current forcing
+ ! in prep_radiation.
+ if (trim(runtype) == 'continue' .or. restart) &
+ call init_shortwave ! initialize radiative transfer
+
+ if (write_ic) call accum_hist(dt) ! write initial conditions
+
+! tcraig, use advance_timestep here
+! istep = istep + 1 ! update time step counters
+! istep1 = istep1 + 1
+! time = time + dt ! determine the time and date
+! call calendar(time) ! at the end of the first timestep
+ call advance_timestep()
+
+ !--------------------------------------------------------------------
+ ! coupler communication or forcing data initialization
+ !--------------------------------------------------------------------
+
+ call init_forcing_atmo ! initialize atmospheric forcing (standalone)
+
+ if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice
+ call get_forcing_atmo ! atmospheric forcing from data
+ call get_forcing_ocn(dt) ! ocean forcing from data
+
+ ! snow aging lookup table initialization
+ if (tr_snow) then ! advanced snow physics
+ call icepack_init_snow()
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+ if (snw_aging_table(1:4) /= 'test') then
+ call init_snowtable()
+ endif
+ endif
+
+ ! isotopes
+ if (tr_iso) call fiso_default ! default values
+
+ ! aerosols
+ ! if (tr_aero) call faero_data ! data file
+ ! if (tr_zaero) call fzaero_data ! data file (gx1)
+ if (tr_aero .or. tr_zaero) call faero_default ! default values
+ if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry
+ if (z_tracers) call get_atm_bgc ! biogeochemistry
+
+ if (runtype == 'initial' .and. .not. restart) &
+ call init_shortwave ! initialize radiative transfer using current swdn
+
+ call init_flux_atm ! initialize atmosphere fluxes sent to coupler
+ call init_flux_ocn ! initialize ocean fluxes sent to coupler
+
+ if (my_task == master_task) then
+ call ice_memusage_print(nu_diag,subname//':end')
+ endif
+
+ end subroutine cice_init
+
+!=======================================================================
+
+ subroutine init_restart
+
+ use ice_arrays_column, only: dhsn
+ use ice_blocks, only: nx_block, ny_block
+ use ice_calendar, only: calendar
+ use ice_constants, only: c0
+ use ice_domain, only: nblocks
+ use ice_domain_size, only: ncat, n_iso, n_aero, nfsd, nslyr
+ use ice_dyn_eap, only: read_restart_eap
+ use ice_dyn_shared, only: kdyn
+ use ice_grid, only: tmask
+ use ice_init, only: ice_ic
+ use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, &
+ init_meltponds_lvl, init_meltponds_topo, &
+ init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd
+ use ice_restart_column, only: restart_age, read_restart_age, &
+ restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, &
+ restart_pond_lvl, read_restart_pond_lvl, &
+ restart_pond_topo, read_restart_pond_topo, &
+ restart_snow, read_restart_snow, &
+ restart_fsd, read_restart_fsd, &
+ restart_iso, read_restart_iso, &
+ restart_aero, read_restart_aero, &
+ restart_hbrine, read_restart_hbrine, &
+ restart_zsal, restart_bgc
+ use ice_restart_driver, only: restartfile
+ use ice_restart_shared, only: runtype, restart
+ use ice_state ! almost everything
+
+ integer(kind=int_kind) :: &
+ i, j , & ! horizontal indices
+ iblk ! block index
+ logical(kind=log_kind) :: &
+ tr_iage, tr_FY, tr_lvl, tr_pond_lvl, &
+ tr_pond_topo, tr_snow, tr_fsd, tr_iso, tr_aero, tr_brine, &
+ skl_bgc, z_tracers, solve_zsal
+ integer(kind=int_kind) :: &
+ ntrcr
+ integer(kind=int_kind) :: &
+ nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, &
+ nt_smice, nt_smliq, nt_rhos, nt_rsnw, &
+ nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice
+
+ character(len=*), parameter :: subname = '(init_restart)'
+
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_query_parameters(skl_bgc_out=skl_bgc, &
+ z_tracers_out=z_tracers, solve_zsal_out=solve_zsal)
+ call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, &
+ tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, &
+ tr_pond_topo_out=tr_pond_topo, tr_aero_out=tr_aero, tr_brine_out=tr_brine, &
+ tr_snow_out=tr_snow, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso)
+ call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, &
+ nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, &
+ nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, &
+ nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, &
+ nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, &
+ nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ if (trim(runtype) == 'continue') then
+ ! start from core restart file
+ call restartfile() ! given by pointer in ice_in
+ call calendar() ! update time parameters
+ if (kdyn == 2) call read_restart_eap ! EAP
+ else if (restart) then ! ice_ic = core restart file
+ call restartfile (ice_ic) ! or 'default' or 'none'
+ !!! uncomment to create netcdf
+ ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file
+ !!! uncomment if EAP restart data exists
+ ! if (kdyn == 2) call read_restart_eap
+ endif
+
+ ! tracers
+ ! ice age tracer
+ if (tr_iage) then
+ if (trim(runtype) == 'continue') &
+ restart_age = .true.
+ if (restart_age) then
+ call read_restart_age
+ else
+ do iblk = 1, nblocks
+ call init_age(trcrn(:,:,nt_iage,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+ ! first-year area tracer
+ if (tr_FY) then
+ if (trim(runtype) == 'continue') restart_FY = .true.
+ if (restart_FY) then
+ call read_restart_FY
+ else
+ do iblk = 1, nblocks
+ call init_FY(trcrn(:,:,nt_FY,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+ ! level ice tracer
+ if (tr_lvl) then
+ if (trim(runtype) == 'continue') restart_lvl = .true.
+ if (restart_lvl) then
+ call read_restart_lvl
+ else
+ do iblk = 1, nblocks
+ call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), &
+ trcrn(:,:,nt_vlvl,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+ ! level-ice melt ponds
+ if (tr_pond_lvl) then
+ if (trim(runtype) == 'continue') &
+ restart_pond_lvl = .true.
+ if (restart_pond_lvl) then
+ call read_restart_pond_lvl
+ else
+ do iblk = 1, nblocks
+ call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), &
+ trcrn(:,:,nt_hpnd,:,iblk), &
+ trcrn(:,:,nt_ipnd,:,iblk), &
+ dhsn(:,:,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+ ! topographic melt ponds
+ if (tr_pond_topo) then
+ if (trim(runtype) == 'continue') &
+ restart_pond_topo = .true.
+ if (restart_pond_topo) then
+ call read_restart_pond_topo
+ else
+ do iblk = 1, nblocks
+ call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), &
+ trcrn(:,:,nt_hpnd,:,iblk), &
+ trcrn(:,:,nt_ipnd,:,iblk))
+ enddo ! iblk
+ endif ! .not. restart_pond
+ endif
+
+ ! snow redistribution/metamorphism
+ if (tr_snow) then
+ if (trim(runtype) == 'continue') restart_snow = .true.
+ if (restart_snow) then
+ call read_restart_snow
+ else
+ do iblk = 1, nblocks
+ call init_snowtracers(trcrn(:,:,nt_smice:nt_smice+nslyr-1,:,iblk), &
+ trcrn(:,:,nt_smliq:nt_smliq+nslyr-1,:,iblk), &
+ trcrn(:,:,nt_rhos :nt_rhos +nslyr-1,:,iblk), &
+ trcrn(:,:,nt_rsnw :nt_rsnw +nslyr-1,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+
+ ! floe size distribution
+ if (tr_fsd) then
+ if (trim(runtype) == 'continue') restart_fsd = .true.
+ if (restart_fsd) then
+ call read_restart_fsd
+ else
+ call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:))
+ endif
+ endif
+
+ ! isotopes
+ if (tr_iso) then
+ if (trim(runtype) == 'continue') restart_iso = .true.
+ if (restart_iso) then
+ call read_restart_iso
+ else
+ do iblk = 1, nblocks
+ call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), &
+ trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk))
+ enddo ! iblk
+ endif
+ endif
+
+ if (tr_aero) then ! ice aerosol
+ if (trim(runtype) == 'continue') restart_aero = .true.
+ if (restart_aero) then
+ call read_restart_aero
+ else
+ do iblk = 1, nblocks
+ call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk))
+ enddo ! iblk
+ endif ! .not. restart_aero
+ endif
+
+ if (trim(runtype) == 'continue') then
+ if (tr_brine) &
+ restart_hbrine = .true.
+ if (solve_zsal) &
+ restart_zsal = .true.
+ if (skl_bgc .or. z_tracers) &
+ restart_bgc = .true.
+ endif
+
+ if (tr_brine .or. skl_bgc) then ! brine height tracer
+ call init_hbrine
+ if (tr_brine .and. restart_hbrine) call read_restart_hbrine
+ endif
+
+ if (solve_zsal .or. skl_bgc .or. z_tracers) then ! biogeochemistry
+ if (tr_fsd) then
+ write (nu_diag,*) 'FSD implementation incomplete for use with BGC'
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+ endif
+ call init_bgc
+ endif
+
+ !-----------------------------------------------------------------
+ ! aggregate tracers
+ !-----------------------------------------------------------------
+
+ !$OMP PARALLEL DO PRIVATE(iblk)
+ do iblk = 1, nblocks
+ do j = 1, ny_block
+ do i = 1, nx_block
+ if (tmask(i,j,iblk)) then
+ call icepack_aggregate(ncat = ncat, &
+ aicen = aicen(i,j,:,iblk), &
+ trcrn = trcrn(i,j,:,:,iblk), &
+ vicen = vicen(i,j,:,iblk), &
+ vsnon = vsnon(i,j,:,iblk), &
+ aice = aice (i,j, iblk), &
+ trcr = trcr (i,j,:,iblk), &
+ vice = vice (i,j, iblk), &
+ vsno = vsno (i,j, iblk), &
+ aice0 = aice0(i,j, iblk), &
+ ntrcr = ntrcr, &
+ trcr_depend = trcr_depend, &
+ trcr_base = trcr_base, &
+ n_trcr_strata = n_trcr_strata, &
+ nt_strata = nt_strata)
+ else
+ ! tcraig, reset all tracer values on land to zero
+ trcrn(i,j,:,:,iblk) = c0
+ endif
+ enddo
+ enddo
+ enddo
+ !$OMP END PARALLEL DO
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine init_restart
+
+!=======================================================================
+
+ end module CICE_InitMod
+
+!=======================================================================
diff --git a/cicecore/drivers/unittest/opticep/CICE_RunMod.F90 b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90
new file mode 100644
index 000000000..ae7f7ab1f
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/CICE_RunMod.F90
@@ -0,0 +1,741 @@
+!=======================================================================
+!
+! Main driver for time stepping of CICE.
+!
+! authors Elizabeth C. Hunke, LANL
+! Philip W. Jones, LANL
+! William H. Lipscomb, LANL
+!
+! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep
+! 2006 ECH: Streamlined for efficiency
+! 2006 ECH: Converted to free source form (F90)
+! 2007 BPB: Modified Delta-Eddington shortwave interface
+! 2008 ECH: moved ESMF code to its own driver
+
+ module CICE_RunMod
+
+ use ice_kinds_mod
+ use ice_communicate, only: my_task, master_task
+ use ice_fileunits, only: nu_diag
+ use ice_arrays_column, only: oceanmixed_ice
+ use ice_constants, only: c0, c1
+ use ice_constants, only: field_loc_center, field_type_scalar
+ use ice_exit, only: abort_ice
+ use ice_memusage, only: ice_memusage_print
+ use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
+ use icepack_intfc, only: icepack_max_iso, icepack_max_aero
+ use icepack_intfc, only: icepack_query_parameters
+ use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes
+
+ implicit none
+ private
+ public :: CICE_Run, ice_step
+
+!=======================================================================
+
+ contains
+
+!=======================================================================
+!
+! This is the main driver routine for advancing CICE forward in time.
+!
+! author Elizabeth C. Hunke, LANL
+! Philip W. Jones, LANL
+! William H. Lipscomb, LANL
+
+ subroutine CICE_Run
+
+ use ice_calendar, only: dt, stop_now, advance_timestep
+ use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, &
+ get_wave_spec
+ use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, &
+ fiso_default, faero_default
+ use ice_flux, only: init_flux_atm, init_flux_ocn
+ use ice_timers, only: ice_timer_start, ice_timer_stop, &
+ timer_couple, timer_step
+ logical (kind=log_kind) :: &
+ tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd
+ character(len=*), parameter :: subname = '(CICE_Run)'
+
+ !--------------------------------------------------------------------
+ ! initialize error code and step timer
+ !--------------------------------------------------------------------
+
+ call ice_timer_start(timer_step) ! start timing entire run
+
+ call icepack_query_parameters(skl_bgc_out=skl_bgc, &
+ z_tracers_out=z_tracers, &
+ wave_spec_out=wave_spec)
+ call icepack_query_tracer_flags(tr_iso_out=tr_iso, &
+ tr_aero_out=tr_aero, &
+ tr_zaero_out=tr_zaero, &
+ tr_fsd_out=tr_fsd)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+#ifndef CICE_IN_NEMO
+ !--------------------------------------------------------------------
+ ! timestep loop
+ !--------------------------------------------------------------------
+
+ timeLoop: do
+#endif
+
+ call ice_step
+
+! tcraig, use advance_timestep now
+! istep = istep + 1 ! update time step counters
+! istep1 = istep1 + 1
+! time = time + dt ! determine the time and date
+! call calendar(time) ! at the end of the timestep
+ call advance_timestep() ! advance time
+
+#ifndef CICE_IN_NEMO
+ if (stop_now >= 1) exit timeLoop
+#endif
+
+ call ice_timer_start(timer_couple) ! atm/ocn coupling
+
+! for now, wave_spectrum is constant in time
+! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice
+ call get_forcing_atmo ! atmospheric forcing from data
+ call get_forcing_ocn(dt) ! ocean forcing from data
+
+ ! isotopes
+ if (tr_iso) call fiso_default ! default values
+ ! aerosols
+ ! if (tr_aero) call faero_data ! data file
+ ! if (tr_zaero) call fzaero_data ! data file (gx1)
+ if (tr_aero .or. tr_zaero) call faero_default ! default values
+
+ if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry
+ if (z_tracers) call get_atm_bgc ! biogeochemistry
+
+ call init_flux_atm ! Initialize atmosphere fluxes sent to coupler
+ call init_flux_ocn ! initialize ocean fluxes sent to coupler
+
+ call ice_timer_stop(timer_couple) ! atm/ocn coupling
+
+#ifndef CICE_IN_NEMO
+ enddo timeLoop
+#endif
+
+ !--------------------------------------------------------------------
+ ! end of timestep loop
+ !--------------------------------------------------------------------
+
+ call ice_timer_stop(timer_step) ! end timestepping loop timer
+
+ end subroutine CICE_Run
+
+!=======================================================================
+!
+! Calls drivers for physics components, some initialization, and output
+!
+! author Elizabeth C. Hunke, LANL
+! William H. Lipscomb, LANL
+
+ subroutine ice_step
+
+ use ice_boundary, only: ice_HaloUpdate
+ use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep
+ use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice
+ use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags
+ use ice_domain, only: halo_info, nblocks
+ use ice_dyn_eap, only: write_restart_eap
+ use ice_dyn_shared, only: kdyn, kridge
+ use ice_flux, only: scale_factor, init_history_therm, &
+ daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd
+ use ice_history, only: accum_hist
+ use ice_history_bgc, only: init_history_bgc
+ use ice_restart, only: final_restart
+ use ice_restart_column, only: write_restart_age, write_restart_FY, &
+ write_restart_lvl, write_restart_pond_lvl, &
+ write_restart_pond_topo, write_restart_aero, write_restart_fsd, &
+ write_restart_iso, write_restart_bgc, write_restart_hbrine, &
+ write_restart_snow
+ use ice_restart_driver, only: dumpfile
+ use ice_restoring, only: restore_ice, ice_HaloRestore
+ use ice_step_mod, only: prep_radiation, step_therm1, step_therm2, &
+ update_state, step_dyn_horiz, step_dyn_ridge, step_radiation, &
+ biogeochemistry, step_prep, step_dyn_wave, step_snow
+ use ice_timers, only: ice_timer_start, ice_timer_stop, &
+ timer_diags, timer_column, timer_thermo, timer_bound, &
+ timer_hist, timer_readwrite
+
+ integer (kind=int_kind) :: &
+ iblk , & ! block index
+ k , & ! dynamics supercycling index
+ ktherm ! thermodynamics is off when ktherm = -1
+
+ real (kind=dbl_kind) :: &
+ offset ! d(age)/dt time offset
+
+ logical (kind=log_kind) :: &
+ tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, &
+ tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, &
+ calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec
+
+ character(len=*), parameter :: subname = '(ice_step)'
+
+ character (len=char_len) :: plabeld
+
+ if (debug_model) then
+ plabeld = 'beginning time step'
+ do iblk = 1, nblocks
+ call debug_ice (iblk, plabeld)
+ enddo
+ endif
+
+ call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, &
+ solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, &
+ wave_spec_out=wave_spec)
+ call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, &
+ tr_lvl_out=tr_lvl, tr_pond_lvl_out=tr_pond_lvl, &
+ tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_aero_out=tr_aero, &
+ tr_iso_out=tr_iso, tr_fsd_out=tr_fsd, tr_snow_out=tr_snow)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! restoring on grid boundaries
+ !-----------------------------------------------------------------
+
+ if (restore_ice) call ice_HaloRestore
+
+ !-----------------------------------------------------------------
+ ! initialize diagnostics and save initial state values
+ !-----------------------------------------------------------------
+
+ call ice_timer_start(timer_diags) ! diagnostics/history
+ call init_mass_diags ! diagnostics per timestep
+ call init_history_therm
+ call init_history_bgc
+ call ice_timer_stop(timer_diags) ! diagnostics/history
+
+ call ice_timer_start(timer_column) ! column physics
+ call ice_timer_start(timer_thermo) ! thermodynamics
+
+ call step_prep
+
+ if (ktherm >= 0) then
+ !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime)
+ do iblk = 1, nblocks
+
+ !-----------------------------------------------------------------
+ ! scale radiation fields
+ !-----------------------------------------------------------------
+
+ if (calc_Tsfc) call prep_radiation (iblk)
+
+ if (debug_model) then
+ plabeld = 'post prep_radiation'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ !-----------------------------------------------------------------
+ ! thermodynamics and biogeochemistry
+ !-----------------------------------------------------------------
+
+ call step_therm1 (dt, iblk) ! vertical thermodynamics
+
+ if (debug_model) then
+ plabeld = 'post step_therm1'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ call biogeochemistry (dt, iblk) ! biogeochemistry
+
+ if (debug_model) then
+ plabeld = 'post biogeochemistry'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ call step_therm2 (dt, iblk) ! ice thickness distribution thermo
+
+ if (debug_model) then
+ plabeld = 'post step_therm2'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ enddo
+ !$OMP END PARALLEL DO
+ endif ! ktherm > 0
+
+ ! clean up, update tendency diagnostics
+ offset = dt
+ call update_state (dt, daidtt, dvidtt, dagedtt, offset)
+
+ call ice_timer_stop(timer_thermo) ! thermodynamics
+ call ice_timer_stop(timer_column) ! column physics
+
+ !-----------------------------------------------------------------
+ ! dynamics, transport, ridging
+ !-----------------------------------------------------------------
+
+ ! wave fracture of the floe size distribution
+ ! note this is called outside of the dynamics subcycling loop
+ if (tr_fsd .and. wave_spec) call step_dyn_wave(dt)
+
+ do k = 1, ndtd
+
+ ! momentum, stress, transport
+ call step_dyn_horiz (dt_dyn)
+
+ if (debug_model) then
+ plabeld = 'post step_dyn_horiz'
+ do iblk = 1, nblocks
+ call debug_ice (iblk, plabeld)
+ enddo ! iblk
+ endif
+
+ ! ridging
+ !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime)
+ do iblk = 1, nblocks
+ if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk)
+ enddo
+ !$OMP END PARALLEL DO
+
+ if (debug_model) then
+ plabeld = 'post step_dyn_ridge'
+ do iblk = 1, nblocks
+ call debug_ice (iblk, plabeld)
+ enddo ! iblk
+ endif
+
+ ! clean up, update tendency diagnostics
+ offset = c0
+ call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset)
+
+ enddo
+
+ if (debug_model) then
+ plabeld = 'post dynamics'
+ do iblk = 1, nblocks
+ call debug_ice (iblk, plabeld)
+ enddo
+ endif
+
+ call ice_timer_start(timer_column) ! column physics
+ call ice_timer_start(timer_thermo) ! thermodynamics
+
+ !-----------------------------------------------------------------
+ ! snow redistribution and metamorphosis
+ !-----------------------------------------------------------------
+
+ if (tr_snow) then ! advanced snow physics
+ !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime)
+ do iblk = 1, nblocks
+ call step_snow (dt, iblk)
+ enddo
+ !$OMP END PARALLEL DO
+ call update_state (dt) ! clean up
+ endif
+
+ !$OMP PARALLEL DO PRIVATE(iblk) SCHEDULE(runtime)
+ do iblk = 1, nblocks
+
+ !-----------------------------------------------------------------
+ ! albedo, shortwave radiation
+ !-----------------------------------------------------------------
+
+ if (ktherm >= 0) call step_radiation (dt, iblk)
+
+ if (debug_model) then
+ plabeld = 'post step_radiation'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ !-----------------------------------------------------------------
+ ! get ready for coupling and the next time step
+ !-----------------------------------------------------------------
+
+ call coupling_prep (iblk)
+
+ if (debug_model) then
+ plabeld = 'post coupling_prep'
+ call debug_ice (iblk, plabeld)
+ endif
+
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ call ice_timer_start(timer_bound)
+ call ice_HaloUpdate (scale_factor, halo_info, &
+ field_loc_center, field_type_scalar)
+ call ice_timer_stop(timer_bound)
+
+ call ice_timer_stop(timer_thermo) ! thermodynamics
+ call ice_timer_stop(timer_column) ! column physics
+
+ !-----------------------------------------------------------------
+ ! write data
+ !-----------------------------------------------------------------
+
+ call ice_timer_start(timer_diags) ! diagnostics
+ if (mod(istep,diagfreq) == 0) then
+ call runtime_diags(dt) ! log file
+ if (solve_zsal) call zsal_diags
+ if (skl_bgc .or. z_tracers) call bgc_diags
+ if (tr_brine) call hbrine_diags
+ if (my_task == master_task) then
+ call ice_memusage_print(nu_diag,subname)
+ endif
+ endif
+ call ice_timer_stop(timer_diags) ! diagnostics
+
+ call ice_timer_start(timer_hist) ! history
+ call accum_hist (dt) ! history file
+ call ice_timer_stop(timer_hist) ! history
+
+ call ice_timer_start(timer_readwrite) ! reading/writing
+ if (write_restart == 1) then
+ call dumpfile ! core variables for restarting
+ if (tr_iage) call write_restart_age
+ if (tr_FY) call write_restart_FY
+ if (tr_lvl) call write_restart_lvl
+ if (tr_pond_lvl) call write_restart_pond_lvl
+ if (tr_pond_topo) call write_restart_pond_topo
+ if (tr_snow) call write_restart_snow
+ if (tr_fsd) call write_restart_fsd
+ if (tr_iso) call write_restart_iso
+ if (tr_aero) call write_restart_aero
+ if (solve_zsal .or. skl_bgc .or. z_tracers) &
+ call write_restart_bgc
+ if (tr_brine) call write_restart_hbrine
+ if (kdyn == 2) call write_restart_eap
+ call final_restart
+ endif
+ call ice_timer_stop(timer_readwrite) ! reading/writing
+
+ end subroutine ice_step
+
+!=======================================================================
+!
+! Prepare for coupling
+!
+! authors: Elizabeth C. Hunke, LANL
+
+ subroutine coupling_prep (iblk)
+
+ use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, &
+ albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn
+ use ice_blocks, only: nx_block, ny_block, get_block, block
+ use ice_domain, only: blocks_ice
+ use ice_calendar, only: dt, nstreams
+ use ice_domain_size, only: ncat
+ use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, &
+ albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, &
+ alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, &
+ fresh_ai, fsalt_ai, fsalt, &
+ fswthru_ai, fhocn, scale_factor, snowfrac, &
+ fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, &
+ swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, &
+ fsens, flat, fswabs, flwout, evap, Tref, Qref, &
+ scale_fluxes, frzmlt_init, frzmlt
+ use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, &
+ fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai
+ use ice_grid, only: tmask
+ use ice_state, only: aicen, aice
+#ifdef CICE_IN_NEMO
+ use ice_state, only: aice_init
+ use ice_flux, only: flatn_f, fsurfn_f
+#endif
+ use ice_step_mod, only: ocean_mixed_layer
+ use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ n , & ! thickness category index
+ i,j , & ! horizontal indices
+ k , & ! tracer index
+ nbtrcr !
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ logical (kind=log_kind) :: &
+ calc_Tsfc !
+
+ real (kind=dbl_kind) :: &
+ cszn , & ! counter for history averaging
+ puny , & !
+ rhofresh , & !
+ netsw ! flag for shortwave radiation presence
+
+ character(len=*), parameter :: subname = '(coupling_prep)'
+
+ call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh)
+ call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr)
+ call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Save current value of frzmlt for diagnostics.
+ ! Update mixed layer with heat and radiation from ice.
+ !-----------------------------------------------------------------
+
+ do j = 1, ny_block
+ do i = 1, nx_block
+ frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk)
+ enddo
+ enddo
+
+ call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling
+
+ if (oceanmixed_ice) &
+ call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst
+
+ !-----------------------------------------------------------------
+ ! Aggregate albedos
+ !-----------------------------------------------------------------
+
+ do j = 1, ny_block
+ do i = 1, nx_block
+ alvdf(i,j,iblk) = c0
+ alidf(i,j,iblk) = c0
+ alvdr(i,j,iblk) = c0
+ alidr(i,j,iblk) = c0
+
+ albice(i,j,iblk) = c0
+ albsno(i,j,iblk) = c0
+ albpnd(i,j,iblk) = c0
+ apeff_ai(i,j,iblk) = c0
+ snowfrac(i,j,iblk) = c0
+
+ ! for history averaging
+ cszn = c0
+ netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk)
+ if (netsw > puny) cszn = c1
+ do n = 1, nstreams
+ albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn
+ enddo
+ enddo
+ enddo
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do n = 1, ncat
+ do j = jlo, jhi
+ do i = ilo, ihi
+ if (aicen(i,j,n,iblk) > puny) then
+
+ alvdf(i,j,iblk) = alvdf(i,j,iblk) &
+ + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alidf(i,j,iblk) = alidf(i,j,iblk) &
+ + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alvdr(i,j,iblk) = alvdr(i,j,iblk) &
+ + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alidr(i,j,iblk) = alidr(i,j,iblk) &
+ + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk)
+
+ netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) &
+ + swvdf(i,j,iblk) + swidf(i,j,iblk)
+ if (netsw > puny) then ! sun above horizon
+ albice(i,j,iblk) = albice(i,j,iblk) &
+ + albicen(i,j,n,iblk)*aicen(i,j,n,iblk)
+ albsno(i,j,iblk) = albsno(i,j,iblk) &
+ + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk)
+ albpnd(i,j,iblk) = albpnd(i,j,iblk) &
+ + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ endif
+
+ apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history
+ + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history
+ + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk)
+
+ endif ! aicen > puny
+ enddo
+ enddo
+ enddo
+
+ do j = 1, ny_block
+ do i = 1, nx_block
+
+ !-----------------------------------------------------------------
+ ! reduce fresh by fpond for coupling
+ !-----------------------------------------------------------------
+
+ if (l_mpond_fresh) then
+ fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt
+ fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk)
+ endif
+
+ !----------------------------------------------------------------
+ ! Store grid box mean albedos and fluxes before scaling by aice
+ !----------------------------------------------------------------
+
+ alvdf_ai (i,j,iblk) = alvdf (i,j,iblk)
+ alidf_ai (i,j,iblk) = alidf (i,j,iblk)
+ alvdr_ai (i,j,iblk) = alvdr (i,j,iblk)
+ alidr_ai (i,j,iblk) = alidr (i,j,iblk)
+ fresh_ai (i,j,iblk) = fresh (i,j,iblk)
+ fsalt_ai (i,j,iblk) = fsalt (i,j,iblk)
+ fhocn_ai (i,j,iblk) = fhocn (i,j,iblk)
+ fswthru_ai(i,j,iblk) = fswthru(i,j,iblk)
+ fzsal_ai (i,j,iblk) = fzsal (i,j,iblk)
+ fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk)
+
+ if (nbtrcr > 0) then
+ do k = 1, nbtrcr
+ flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk)
+ enddo
+ endif
+
+ !-----------------------------------------------------------------
+ ! Save net shortwave for scaling factor in scale_factor
+ !-----------------------------------------------------------------
+ scale_factor(i,j,iblk) = &
+ swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) &
+ + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) &
+ + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) &
+ + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk))
+
+ enddo
+ enddo
+
+ !-----------------------------------------------------------------
+ ! Divide fluxes by ice area
+ ! - the CESM coupler assumes fluxes are per unit ice area
+ ! - also needed for global budget in diagnostics
+ !-----------------------------------------------------------------
+
+ call scale_fluxes (nx_block, ny_block, &
+ tmask (:,:,iblk), nbtrcr, &
+ icepack_max_aero, &
+ aice (:,:,iblk), Tf (:,:,iblk), &
+ Tair (:,:,iblk), Qa (:,:,iblk), &
+ strairxT (:,:,iblk), strairyT(:,:,iblk), &
+ fsens (:,:,iblk), flat (:,:,iblk), &
+ fswabs (:,:,iblk), flwout (:,:,iblk), &
+ evap (:,:,iblk), &
+ Tref (:,:,iblk), Qref (:,:,iblk), &
+ fresh (:,:,iblk), fsalt (:,:,iblk), &
+ fhocn (:,:,iblk), &
+ fswthru (:,:,iblk), &
+ fswthru_vdr (:,:,iblk), &
+ fswthru_vdf (:,:,iblk), &
+ fswthru_idr (:,:,iblk), &
+ fswthru_idf (:,:,iblk), &
+ faero_ocn(:,:,:,iblk), &
+ alvdr (:,:,iblk), alidr (:,:,iblk), &
+ alvdf (:,:,iblk), alidf (:,:,iblk), &
+ fzsal (:,:,iblk), fzsal_g (:,:,iblk), &
+ flux_bio (:,:,1:nbtrcr,iblk), &
+ Qref_iso =Qref_iso (:,:,:,iblk), &
+ fiso_evap=fiso_evap(:,:,:,iblk), &
+ fiso_ocn =fiso_ocn (:,:,:,iblk))
+
+#ifdef CICE_IN_NEMO
+!echmod - comment this out for efficiency, if .not. calc_Tsfc
+ if (.not. calc_Tsfc) then
+
+ !---------------------------------------------------------------
+ ! If surface fluxes were provided, conserve these fluxes at ice
+ ! free points by passing to ocean.
+ !---------------------------------------------------------------
+
+ call sfcflux_to_ocn &
+ (nx_block, ny_block, &
+ tmask (:,:,iblk), aice_init(:,:,iblk), &
+ fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), &
+ fresh (:,:,iblk), fhocn (:,:,iblk))
+ endif
+!echmod
+#endif
+ call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling
+
+ end subroutine coupling_prep
+
+#ifdef CICE_IN_NEMO
+
+!=======================================================================
+!
+! If surface heat fluxes are provided to CICE instead of CICE calculating
+! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can
+! be provided at points which do not have ice. (This is could be due to
+! the heat fluxes being calculated on a lower resolution grid or the
+! heat fluxes not recalculated at every CICE timestep.) At ice free points,
+! conserve energy and water by passing these fluxes to the ocean.
+!
+! author: A. McLaren, Met Office
+
+ subroutine sfcflux_to_ocn(nx_block, ny_block, &
+ tmask, aice, &
+ fsurfn_f, flatn_f, &
+ fresh, fhocn)
+
+ use ice_domain_size, only: ncat
+
+ integer (kind=int_kind), intent(in) :: &
+ nx_block, ny_block ! block dimensions
+
+ logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: &
+ tmask ! land/boundary mask, thickness (T-cell)
+
+ real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: &
+ aice ! initial ice concentration
+
+ real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: &
+ fsurfn_f, & ! net surface heat flux (provided as forcing)
+ flatn_f ! latent heat flux (provided as forcing)
+
+ real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: &
+ fresh , & ! fresh water flux to ocean (kg/m2/s)
+ fhocn ! actual ocn/ice heat flx (W/m**2)
+
+
+ ! local variables
+ integer (kind=int_kind) :: &
+ i, j, n ! horizontal indices
+
+ real (kind=dbl_kind) :: &
+ puny, & !
+ Lsub, & !
+ rLsub ! 1/Lsub
+
+ character(len=*), parameter :: subname = '(sfcflux_to_ocn)'
+
+ call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+ rLsub = c1 / Lsub
+
+ do n = 1, ncat
+ do j = 1, ny_block
+ do i = 1, nx_block
+ if (tmask(i,j) .and. aice(i,j) <= puny) then
+ fhocn(i,j) = fhocn(i,j) &
+ + fsurfn_f(i,j,n) + flatn_f(i,j,n)
+ fresh(i,j) = fresh(i,j) &
+ + flatn_f(i,j,n) * rLsub
+ endif
+ enddo ! i
+ enddo ! j
+ enddo ! n
+
+
+ end subroutine sfcflux_to_ocn
+
+#endif
+
+!=======================================================================
+
+ end module CICE_RunMod
+
+!=======================================================================
diff --git a/cicecore/drivers/unittest/opticep/README b/cicecore/drivers/unittest/opticep/README
new file mode 100644
index 000000000..b5f1bdf9c
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/README
@@ -0,0 +1,30 @@
+
+This unittest tests Icepack optional arguments. The idea is to have source code that is
+identical to the standard CICE source code except the significant optional arguments passed
+into Icepack are removed from the CICE calls. Then to run a standard CICE case with optional
+features (fsd, bgc, isotopes, etc) off in namelist. That results should be bit-for-bit identical
+with an equivalent run from the standard source code.
+
+This unittest will need to be maintained manually. As CICE code changes, the modified files
+in the unittest also need to be update manually. Again, it should be as easy as copying the
+standard files into this directory and then commenting out the optional arguments.
+
+NOTES:
+
+All files from cicecore/drivers/standalone/cice need to be copied to this directory. As of
+today, that includes
+ CICE.F90
+ CICE_FinalMod.F90
+ CICE_InitMod.F90
+ CICE_RunMod.F90
+
+Add
+ write(nu_diag, *) "OPTICEP TEST COMPLETED SUCCESSFULLY "
+to CICE_FinalMod.F90
+
+Do not worry about the parameter/tracer query/init/write methods
+
+Interfaces to modify include
+ ice_init_column.F90 (icepack_step_radiation, icepack_init_zbgc)
+ ice_step_mod.F90 (icepack_step_therm1, icepack_step_therm2, icepack_prep_radiation,
+ icepack_step_radiation, icepack_step_ridge)
diff --git a/cicecore/drivers/unittest/opticep/ice_init_column.F90 b/cicecore/drivers/unittest/opticep/ice_init_column.F90
new file mode 100644
index 000000000..82f3f4a1e
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/ice_init_column.F90
@@ -0,0 +1,3135 @@
+!=========================================================================
+!
+! Initialization routines for the column package.
+!
+! author: Elizabeth C. Hunke, LANL
+!
+ module ice_init_column
+
+ use ice_kinds_mod
+ use ice_blocks, only: nx_block, ny_block
+ use ice_constants
+ use ice_communicate, only: my_task, master_task, ice_barrier
+ use ice_domain_size, only: ncat, max_blocks
+ use ice_domain_size, only: nblyr, nilyr, nslyr
+ use ice_domain_size, only: n_aero, n_zaero, n_algae
+ use ice_domain_size, only: n_doc, n_dic, n_don
+ use ice_domain_size, only: n_fed, n_fep
+ use ice_fileunits, only: nu_diag
+ use ice_fileunits, only: nu_nml, nml_filename, get_fileunit, &
+ release_fileunit, flush_fileunit
+ use ice_exit, only: abort_ice
+ use icepack_intfc, only: icepack_max_don, icepack_max_doc, icepack_max_dic
+ use icepack_intfc, only: icepack_max_algae, icepack_max_aero, icepack_max_fe
+ use icepack_intfc, only: icepack_max_nbtrcr
+ use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
+ use icepack_intfc, only: icepack_init_tracer_sizes, icepack_init_tracer_flags
+ use icepack_intfc, only: icepack_init_tracer_indices
+ use icepack_intfc, only: icepack_init_parameters
+ use icepack_intfc, only: icepack_query_tracer_sizes, icepack_query_tracer_flags
+ use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes
+ use icepack_intfc, only: icepack_query_parameters
+ use icepack_intfc, only: icepack_write_tracer_sizes, icepack_write_tracer_flags
+ use icepack_intfc, only: icepack_write_tracer_indices, icepack_write_tracer_sizes
+ use icepack_intfc, only: icepack_init_fsd, icepack_cleanup_fsd
+ use icepack_intfc, only: icepack_init_zbgc
+ use icepack_intfc, only: icepack_init_thermo
+ use icepack_intfc, only: icepack_step_radiation, icepack_init_orbit
+ use icepack_intfc, only: icepack_init_bgc, icepack_init_zsalinity
+ use icepack_intfc, only: icepack_init_ocean_bio, icepack_load_ocean_bio_array
+ use icepack_intfc, only: icepack_init_hbrine
+
+ implicit none
+
+ private
+ public :: init_thermo_vertical, init_shortwave, &
+ init_age, init_FY, init_lvl, init_fsd, &
+ init_meltponds_lvl, init_meltponds_topo, &
+ init_aerosol, init_bgc, init_hbrine, init_zbgc, input_zbgc, &
+ count_tracers, init_isotope, init_snowtracers
+
+ ! namelist parameters needed locally
+
+ real (kind=dbl_kind) :: &
+ tau_min , tau_max , &
+ nitratetype , ammoniumtype , silicatetype, &
+ dmspptype , dmspdtype , humtype
+
+ real (kind=dbl_kind), dimension(icepack_max_dic) :: &
+ dictype
+
+ real (kind=dbl_kind), dimension(icepack_max_algae) :: &
+ algaltype ! tau_min for both retention and release
+
+ real (kind=dbl_kind), dimension(icepack_max_doc) :: &
+ doctype
+
+ real (kind=dbl_kind), dimension(icepack_max_don) :: &
+ dontype
+
+ real (kind=dbl_kind), dimension(icepack_max_fe) :: &
+ fedtype
+
+ real (kind=dbl_kind), dimension(icepack_max_fe) :: &
+ feptype
+
+ real (kind=dbl_kind), dimension(icepack_max_aero) :: &
+ zaerotype
+
+ real (kind=dbl_kind) :: &
+ grid_o, l_sk, grid_o_t, initbio_frac, &
+ frazil_scav, grid_oS, l_skS, &
+ phi_snow, &
+ ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , &
+ ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , &
+ ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , &
+ ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , &
+ ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , &
+ fr_resp , &
+ algal_vel , R_dFe2dust , dustFe_sol , &
+ chlabs_diatoms , chlabs_sp , chlabs_phaeo , &
+ alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, &
+ beta2max_diatoms , beta2max_sp , beta2max_phaeo , &
+ mu_max_diatoms , mu_max_sp , mu_max_phaeo , &
+ grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , &
+ fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , &
+ mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , &
+ mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , &
+ k_exude_diatoms , k_exude_sp , k_exude_phaeo , &
+ K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , &
+ K_Am_diatoms , K_Am_sp , K_Am_phaeo , &
+ K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , &
+ K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , &
+ f_don_protein , kn_bac_protein , f_don_Am_protein , &
+ f_doc_s , f_doc_l , f_exude_s , &
+ f_exude_l , k_bac_s , k_bac_l , &
+ T_max , fsal , op_dep_min , &
+ fr_graze_s , fr_graze_e , fr_mort2min , &
+ fr_dFe , k_nitrif , t_iron_conv , &
+ max_loss , max_dfe_doc1 , fr_resp_s , &
+ y_sk_DMS , t_sk_conv , t_sk_ox , &
+ algaltype_diatoms , algaltype_sp , algaltype_phaeo , &
+ doctype_s , doctype_l , dontype_protein , &
+ fedtype_1 , feptype_1 , zaerotype_bc1 , &
+ zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , &
+ zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , &
+ ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, &
+ ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , &
+ F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins
+
+!=======================================================================
+
+ contains
+
+!=======================================================================
+!
+! Initialize the vertical profile of ice salinity and melting temperature.
+!
+! authors: C. M. Bitz, UW
+! William H. Lipscomb, LANL
+
+ subroutine init_thermo_vertical
+
+ use ice_flux, only: salinz, Tmltz
+
+ integer (kind=int_kind) :: &
+ i, j, iblk, & ! horizontal indices
+ k ! ice layer index
+
+ real (kind=dbl_kind), dimension(nilyr+1) :: &
+ sprofile ! vertical salinity profile
+
+ real (kind=dbl_kind) :: &
+ depressT
+
+ character(len=*), parameter :: subname='(init_thermo_vertical)'
+
+ !-----------------------------------------------------------------
+ ! initialize
+ !-----------------------------------------------------------------
+
+ call icepack_query_parameters(depressT_out=depressT)
+ call icepack_init_thermo(nilyr=nilyr, sprofile=sprofile)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Prescibe vertical profile of salinity and melting temperature.
+ ! Note this profile is only used for BL99 thermodynamics.
+ !-----------------------------------------------------------------
+
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,k)
+ do iblk = 1,max_blocks
+ do j = 1, ny_block
+ do i = 1, nx_block
+ do k = 1, nilyr+1
+ salinz(i,j,k,iblk) = sprofile(k)
+ Tmltz (i,j,k,iblk) = -salinz(i,j,k,iblk)*depressT
+ enddo ! k
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ end subroutine init_thermo_vertical
+
+!=======================================================================
+!
+! Initialize shortwave
+
+ subroutine init_shortwave
+
+ use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, &
+ albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, &
+ fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, &
+ fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, &
+ kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, &
+ swgrid, igrid
+ use ice_blocks, only: block, get_block
+ use ice_calendar, only: dt, calendar_type, &
+ days_per_year, nextsw_cday, yday, msec
+ use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc
+ use ice_domain, only: nblocks, blocks_ice
+ use ice_flux, only: alvdf, alidf, alvdr, alidr, &
+ alvdr_ai, alidr_ai, alvdf_ai, alidf_ai, &
+ swvdr, swvdf, swidr, swidf, scale_factor, snowfrac, &
+ albice, albsno, albpnd, apeff_ai, coszen, fsnow
+ use ice_grid, only: tlat, tlon, tmask
+ use ice_restart_shared, only: restart, runtype
+ use ice_state, only: aicen, vicen, vsnon, trcrn
+
+ integer (kind=int_kind) :: &
+ i, j , k , & ! horizontal indices
+ iblk , & ! block index
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ n ! thickness category index
+
+ real (kind=dbl_kind) :: &
+ netsw ! flag for shortwave radiation presence
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ logical (kind=log_kind) :: &
+ l_print_point, & ! flag to print designated grid point diagnostics
+ debug, & ! if true, print diagnostics
+ dEdd_algae, & ! use prognostic chla in dEdd radiation
+ modal_aero, & ! use modal aerosol optical treatment
+ snwgrain ! use variable snow radius
+
+ character (char_len) :: shortwave
+
+ integer (kind=int_kind) :: &
+ ipoint
+
+ real (kind=dbl_kind), dimension(ncat) :: &
+ fbri ! brine height to ice thickness
+
+ real(kind= dbl_kind), dimension(:,:), allocatable :: &
+ ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3)
+ rsnow ! snow grain radius tracer (10^-6 m)
+
+ logical (kind=log_kind) :: tr_brine, tr_zaero, tr_bgc_n
+ integer (kind=int_kind) :: nt_alvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero, &
+ nt_fbri, nt_tsfc, ntrcr, nbtrcr, nbtrcr_sw, nt_rsnw
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nt_bgc_N
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nt_zaero
+ real (kind=dbl_kind) :: puny
+
+ character(len=*), parameter :: subname='(init_shortwave)'
+
+ call icepack_query_parameters(puny_out=puny)
+ call icepack_query_parameters(shortwave_out=shortwave)
+ call icepack_query_parameters(dEdd_algae_out=dEdd_algae)
+ call icepack_query_parameters(modal_aero_out=modal_aero)
+ call icepack_query_parameters(snwgrain_out=snwgrain)
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw)
+ call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_zaero_out=tr_zaero, &
+ tr_bgc_n_out=tr_bgc_n)
+ call icepack_query_tracer_indices(nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, &
+ nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, &
+ nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, nt_rsnw_out=nt_rsnw)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ allocate(ztrcr_sw(nbtrcr_sw, ncat))
+ allocate(rsnow(nslyr,ncat))
+
+ do iblk=1,nblocks
+
+ ! Initialize
+ fswpenln(:,:,:,:,iblk) = c0
+ Iswabsn(:,:,:,:,iblk) = c0
+ Sswabsn(:,:,:,:,iblk) = c0
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = 1, ny_block ! can be jlo, jhi
+ do i = 1, nx_block ! can be ilo, ihi
+
+ l_print_point = .false.
+ debug = .false.
+ if (debug .and. print_points) then
+ do ipoint = 1, npnt
+ if (my_task == pmloc(ipoint) .and. &
+ i == piloc(ipoint) .and. &
+ j == pjloc(ipoint)) &
+ l_print_point = .true.
+ write (nu_diag, *) 'my_task = ',my_task
+ enddo ! n
+ endif
+
+ alvdf(i,j,iblk) = c0
+ alidf(i,j,iblk) = c0
+ alvdr(i,j,iblk) = c0
+ alidr(i,j,iblk) = c0
+ alvdr_ai(i,j,iblk) = c0
+ alidr_ai(i,j,iblk) = c0
+ alvdf_ai(i,j,iblk) = c0
+ alidf_ai(i,j,iblk) = c0
+ albice(i,j,iblk) = c0
+ albsno(i,j,iblk) = c0
+ albpnd(i,j,iblk) = c0
+ snowfrac(i,j,iblk) = c0
+ apeff_ai(i,j,iblk) = c0
+
+ do n = 1, ncat
+ alvdrn(i,j,n,iblk) = c0
+ alidrn(i,j,n,iblk) = c0
+ alvdfn(i,j,n,iblk) = c0
+ alidfn(i,j,n,iblk) = c0
+ fswsfcn(i,j,n,iblk) = c0
+ fswintn(i,j,n,iblk) = c0
+ fswthrun(i,j,n,iblk) = c0
+ fswthrun_vdr(i,j,n,iblk) = c0
+ fswthrun_vdf(i,j,n,iblk) = c0
+ fswthrun_idr(i,j,n,iblk) = c0
+ fswthrun_idf(i,j,n,iblk) = c0
+ enddo ! ncat
+
+ enddo
+ enddo
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ if (trim(shortwave) == 'dEdd') then ! delta Eddington
+
+#ifndef CESMCOUPLED
+ ! initialize orbital parameters
+ ! These come from the driver in the coupled model.
+ call icepack_init_orbit()
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(subname//' init_orbit', &
+ file=__FILE__, line=__LINE__)
+#endif
+ endif
+
+ fbri(:) = c0
+ ztrcr_sw(:,:) = c0
+ rsnow (:,:) = c0
+ do n = 1, ncat
+ if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk)
+ if (snwgrain) then
+ do k = 1, nslyr
+ rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk)
+ enddo
+ endif
+ enddo
+
+ if (tmask(i,j,iblk)) then
+ call icepack_step_radiation (dt=dt, ncat=ncat, &
+ nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, &
+ dEdd_algae=dEdd_algae, &
+ swgrid=swgrid(:), igrid=igrid(:), &
+ fbri=fbri(:), &
+ aicen=aicen(i,j,:,iblk), &
+ vicen=vicen(i,j,:,iblk), &
+ vsnon=vsnon(i,j,:,iblk), &
+ Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), &
+ alvln=trcrn(i,j,nt_alvl,:,iblk), &
+ apndn=trcrn(i,j,nt_apnd,:,iblk), &
+ hpndn=trcrn(i,j,nt_hpnd,:,iblk), &
+ ipndn=trcrn(i,j,nt_ipnd,:,iblk), &
+ aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), &
+ bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), &
+ zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), &
+ trcrn_bgcsw=ztrcr_sw, &
+ TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), &
+ calendar_type=calendar_type, &
+ days_per_year=days_per_year, &
+ nextsw_cday=nextsw_cday, yday=yday, &
+ sec=msec, &
+ kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), &
+ waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), &
+ gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), &
+ bcenh=bcenh(:,:,:), &
+ modal_aero=modal_aero, &
+ swvdr=swvdr(i,j,iblk), swvdf=swvdf(i,j,iblk),&
+ swidr=swidr(i,j,iblk), swidf=swidf(i,j,iblk),&
+ coszen=coszen(i,j,iblk), fsnow=fsnow(i,j,iblk),&
+ alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), &
+ alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), &
+ fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), &
+ fswthrun=fswthrun(i,j,:,iblk), &
+!opt fswthrun_vdr=fswthrun_vdr(i,j,:,iblk), &
+!opt fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), &
+!opt fswthrun_idr=fswthrun_idr(i,j,:,iblk), &
+!opt fswthrun_idf=fswthrun_idf(i,j,:,iblk), &
+ fswpenln=fswpenln(i,j,:,:,iblk), &
+ Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), &
+ albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), &
+ albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), &
+ snowfracn=snowfracn(i,j,:,iblk), &
+ dhsn=dhsn(i,j,:,iblk), ffracn=ffracn(i,j,:,iblk), &
+!opt rsnow=rsnow(:,:), &
+ l_print_point=l_print_point, &
+ initonly = .true.)
+ endif
+
+ !-----------------------------------------------------------------
+ ! Define aerosol tracer on shortwave grid
+ !-----------------------------------------------------------------
+
+ if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then
+ do n = 1, ncat
+ do k = 1, nbtrcr_sw
+ trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n)
+ enddo
+ enddo
+ endif
+
+ enddo ! i
+ enddo ! j
+
+ !-----------------------------------------------------------------
+ ! Aggregate albedos
+ ! Match loop order in coupling_prep for same order of operations
+ !-----------------------------------------------------------------
+
+ do n = 1, ncat
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ if (aicen(i,j,n,iblk) > puny) then
+
+ alvdf(i,j,iblk) = alvdf(i,j,iblk) &
+ + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alidf(i,j,iblk) = alidf(i,j,iblk) &
+ + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alvdr(i,j,iblk) = alvdr(i,j,iblk) &
+ + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ alidr(i,j,iblk) = alidr(i,j,iblk) &
+ + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk)
+
+ netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) &
+ + swvdf(i,j,iblk) + swidf(i,j,iblk)
+ if (netsw > puny) then ! sun above horizon
+ albice(i,j,iblk) = albice(i,j,iblk) &
+ + albicen(i,j,n,iblk)*aicen(i,j,n,iblk)
+ albsno(i,j,iblk) = albsno(i,j,iblk) &
+ + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk)
+ albpnd(i,j,iblk) = albpnd(i,j,iblk) &
+ + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ endif
+
+ apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) &
+ + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk)
+ snowfrac(i,j,iblk) = snowfrac(i,j,iblk) &
+ + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk)
+
+ endif ! aicen > puny
+
+ enddo ! i
+ enddo ! j
+ enddo ! ncat
+
+ do j = 1, ny_block
+ do i = 1, nx_block
+
+ !----------------------------------------------------------------
+ ! Store grid box mean albedos and fluxes before scaling by aice
+ !----------------------------------------------------------------
+
+ alvdf_ai (i,j,iblk) = alvdf (i,j,iblk)
+ alidf_ai (i,j,iblk) = alidf (i,j,iblk)
+ alvdr_ai (i,j,iblk) = alvdr (i,j,iblk)
+ alidr_ai (i,j,iblk) = alidr (i,j,iblk)
+
+ ! for history averaging
+!echmod? cszn = c0
+!echmod if (coszen(i,j,iblk) > puny) cszn = c1
+!echmod do n = 1, nstreams
+!echmod albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn
+!echmod enddo
+
+ !----------------------------------------------------------------
+ ! Save net shortwave for scaling factor in scale_factor
+ !----------------------------------------------------------------
+ if (runtype == 'initial' .and. .not. restart) then
+ scale_factor(i,j,iblk) = &
+ swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) &
+ + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) &
+ + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) &
+ + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk))
+ endif
+
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+
+ deallocate(ztrcr_sw)
+ deallocate(rsnow)
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine init_shortwave
+
+!=======================================================================
+
+! Initialize ice age tracer (call prior to reading restart data)
+
+ subroutine init_age(iage)
+
+ real(kind=dbl_kind), dimension(:,:,:), intent(out) :: iage
+ character(len=*),parameter :: subname='(init_age)'
+
+ iage(:,:,:) = c0
+
+ end subroutine init_age
+
+!=======================================================================
+
+! Initialize ice FY tracer (call prior to reading restart data)
+
+ subroutine init_FY(firstyear)
+
+ real(kind=dbl_kind), dimension(:,:,:), intent(out) :: firstyear
+ character(len=*),parameter :: subname='(init_FY)'
+
+ firstyear(:,:,:) = c0
+
+ end subroutine init_FY
+
+!=======================================================================
+
+! Initialize ice lvl tracers (call prior to reading restart data)
+
+ subroutine init_lvl(iblk, alvl, vlvl)
+
+ use ice_constants, only: c0, c1
+ use ice_arrays_column, only: ffracn, dhsn
+
+ integer (kind=int_kind), intent(in) :: iblk
+
+ real (kind=dbl_kind), dimension(:,:,:), intent(out) :: &
+ alvl , & ! level ice area fraction
+ vlvl ! level ice volume
+ character(len=*),parameter :: subname='(init_lvl)'
+
+ alvl(:,:,:) = c1 ! level ice area fraction
+ vlvl(:,:,:) = c1 ! level ice volume
+ ffracn(:,:,:,iblk) = c0
+ dhsn(:,:,:,iblk) = c0
+
+ end subroutine init_lvl
+
+!=======================================================================
+
+! Initialize melt ponds.
+
+ subroutine init_meltponds_lvl(apnd, hpnd, ipnd, dhsn)
+
+ real(kind=dbl_kind), dimension(:,:,:), intent(out) :: &
+ apnd , & ! melt pond area fraction
+ hpnd , & ! melt pond depth
+ ipnd , & ! melt pond refrozen lid thickness
+ dhsn ! depth difference for snow on sea ice and pond ice
+ character(len=*),parameter :: subname='(init_meltponds_lvl)'
+
+ apnd(:,:,:) = c0
+ hpnd(:,:,:) = c0
+ ipnd(:,:,:) = c0
+ dhsn(:,:,:) = c0
+
+ end subroutine init_meltponds_lvl
+
+!=======================================================================
+
+! Initialize melt ponds.
+
+ subroutine init_meltponds_topo(apnd, hpnd, ipnd)
+
+ real(kind=dbl_kind), dimension(:,:,:), intent(out) :: &
+ apnd , & ! melt pond area fraction
+ hpnd , & ! melt pond depth
+ ipnd ! melt pond refrozen lid thickness
+ character(len=*),parameter :: subname='(init_meltponds_topo)'
+
+ apnd(:,:,:) = c0
+ hpnd(:,:,:) = c0
+ ipnd(:,:,:) = c0
+
+ end subroutine init_meltponds_topo
+
+!=======================================================================
+
+! Initialize snow redistribution/metamorphosis tracers (call prior to reading restart data)
+
+ subroutine init_snowtracers(smice, smliq, rhos_cmp, rsnw)
+
+ real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: &
+ smice, smliq, rhos_cmp, rsnw
+ character(len=*),parameter :: subname='(init_snowtracers)'
+
+ real (kind=dbl_kind) :: &
+ rsnw_fall, & ! snow grain radius of new fallen snow (10^-6 m)
+ rhos ! snow density (kg/m^3)
+
+ call icepack_query_parameters(rsnw_fall_out=rsnw_fall, rhos_out=rhos)
+
+ rsnw (:,:,:,:) = rsnw_fall
+ rhos_cmp(:,:,:,:) = rhos
+ smice (:,:,:,:) = rhos
+ smliq (:,:,:,:) = c0
+
+ end subroutine init_snowtracers
+
+!=======================================================================
+
+! Initialize floe size distribution tracer (call prior to reading restart data)
+
+ subroutine init_fsd(floesize)
+
+ use ice_arrays_column, only: floe_rad_c, floe_binwidth, &
+ wavefreq, dwavefreq, wave_sig_ht, wave_spectrum, &
+ d_afsd_newi, d_afsd_latg, d_afsd_latm, d_afsd_wave, d_afsd_weld
+ use ice_domain_size, only: ncat, max_blocks, nfsd
+ use ice_init, only: ice_ic
+ use ice_state, only: aicen
+
+ real(kind=dbl_kind), dimension(:,:,:,:,:), intent(out) :: &
+ floesize ! floe size distribution tracer
+
+ ! local variables
+
+ real (kind=dbl_kind), dimension(nfsd) :: &
+ afsd ! floe size distribution "profile"
+
+ real (kind=dbl_kind), dimension(nfsd,ncat) :: &
+ afsdn ! floe size distribution "profile"
+
+ real (kind=dbl_kind) :: puny
+
+ integer (kind=int_kind) :: &
+ i, j, iblk , & ! horizontal indices
+ n, k ! category index
+
+ logical (kind=log_kind) :: tr_fsd
+
+ character(len=*), parameter :: subname='(init_fsd)'
+
+ call icepack_query_parameters(puny_out=puny)
+
+ wavefreq (:) = c0
+ dwavefreq (:) = c0
+ wave_sig_ht (:,:,:) = c0
+ wave_spectrum (:,:,:,:) = c0
+ d_afsd_newi (:,:,:,:) = c0
+ d_afsd_latg (:,:,:,:) = c0
+ d_afsd_latm (:,:,:,:) = c0
+ d_afsd_wave (:,:,:,:) = c0
+ d_afsd_weld (:,:,:,:) = c0
+
+ ! default: floes occupy the smallest size category in all thickness categories
+ afsdn(:,:) = c0
+ afsdn(1,:) = c1
+ floesize(:,:,:,:,:) = c0
+ floesize(:,:,1,:,:) = c1
+
+ call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ if (tr_fsd) then
+
+ ! initialize floe size distribution the same in every column and category
+ call icepack_init_fsd(nfsd, ice_ic, &
+ floe_rad_c, & ! fsd size bin centre in m (radius)
+ floe_binwidth, & ! fsd size bin width in m (radius)
+ afsd) ! floe size distribution
+
+ do iblk = 1, max_blocks
+ do j = 1, ny_block
+ do i = 1, nx_block
+ do n = 1, ncat
+ do k = 1, nfsd
+ if (aicen(i,j,n,iblk) > puny) afsdn(k,n) = afsd(k)
+ enddo ! k
+ enddo ! n
+
+ call icepack_cleanup_fsd (ncat, nfsd, afsdn) ! renormalize
+
+ do n = 1, ncat
+ do k = 1, nfsd
+ floesize(i,j,k,n,iblk) = afsdn(k,n)
+ enddo ! k
+ enddo ! n
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ endif ! tr_fsd
+
+ end subroutine init_fsd
+
+!=======================================================================
+
+! Initialize isotope tracers (call prior to reading restart data)
+
+ subroutine init_isotope(isosno, isoice)
+
+ real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: &
+ isosno, isoice
+ character(len=*),parameter :: subname='(init_isotope)'
+
+ isosno(:,:,:,:) = c0
+ isoice(:,:,:,:) = c0
+
+ end subroutine init_isotope
+
+!=======================================================================
+
+! Initialize ice aerosol tracer (call prior to reading restart data)
+
+ subroutine init_aerosol(aero)
+
+ real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: &
+ aero ! aerosol tracers
+ character(len=*),parameter :: subname='(init_aerosol)'
+
+ aero(:,:,:,:) = c0
+
+ end subroutine init_aerosol
+
+!=======================================================================
+
+! Initialize vertical profile for biogeochemistry
+
+ subroutine init_bgc()
+
+ use ice_arrays_column, only: zfswin, trcrn_sw, &
+ ocean_bio_all, ice_bio_net, snow_bio_net, &
+ cgrid, igrid, bphi, iDi, bTiz, iki, &
+ Rayleigh_criteria, Rayleigh_real
+ use ice_blocks, only: block, get_block
+ use ice_domain, only: nblocks, blocks_ice
+ use ice_flux, only: sss
+ use ice_flux_bgc, only: nit, amm, sil, dmsp, dms, algalN, &
+ doc, don, dic, fed, fep, zaeros, hum
+ use ice_forcing_bgc, only: init_bgc_data, get_forcing_bgc
+ use ice_restart_column, only: restart_zsal, &
+ read_restart_bgc, restart_bgc
+ use ice_state, only: trcrn
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ i, j, iblk , & ! horizontal indices
+ ilo,ihi,jlo,jhi , & ! beginning and end of physical domain
+ k , & ! vertical index
+ n ! category index
+
+ integer (kind=int_kind) :: &
+ max_nbtrcr, max_algae, max_don, max_doc, max_dic, max_aero, max_fe
+
+ logical (kind=log_kind) :: &
+ RayleighC , &
+ solve_zsal
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ real(kind=dbl_kind), allocatable :: &
+ trcrn_bgc(:,:)
+
+ real(kind=dbl_kind), dimension(nilyr,ncat) :: &
+ sicen
+
+ real(kind=dbl_kind) :: &
+ RayleighR
+
+ integer (kind=int_kind) :: &
+ nbtrcr, ntrcr, ntrcr_o, &
+ nt_sice, nt_bgc_S
+
+ character(len=*), parameter :: subname='(init_bgc)'
+
+ ! Initialize
+
+ call icepack_query_parameters(solve_zsal_out=solve_zsal)
+ call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr, ntrcr_out=ntrcr, ntrcr_o_out=ntrcr_o)
+ call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_bgc_S_out=nt_bgc_S)
+ call icepack_query_tracer_sizes(max_nbtrcr_out=max_nbtrcr, &
+ max_algae_out=max_algae, max_don_out=max_don, max_doc_out=max_doc, &
+ max_dic_out=max_dic, max_aero_out=max_aero, max_fe_out=max_fe)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ allocate(trcrn_bgc(ntrcr,ncat))
+
+ bphi(:,:,:,:,:) = c0 ! initial porosity for no ice
+ iDi (:,:,:,:,:) = c0 ! interface diffusivity
+ bTiz(:,:,:,:,:) = c0 ! initial bio grid ice temperature
+ iki (:,:,:,:,:) = c0 ! permeability
+
+ ocean_bio_all(:,:,:,:) = c0
+ ice_bio_net (:,:,:,:) = c0 ! integrated ice tracer conc (mmol/m^2 or mg/m^2)
+ snow_bio_net (:,:,:,:) = c0 ! integrated snow tracer conc (mmol/m^2 or mg/m^2)
+ zfswin (:,:,:,:,:) = c0 ! shortwave flux on bio grid
+ trcrn_sw (:,:,:,:,:) = c0 ! tracers active in the shortwave calculation
+ trcrn_bgc (:,:) = c0
+ RayleighR = c0
+ RayleighC = .false.
+
+ !-----------------------------------------------------------------
+ ! zsalinity initialization
+ !-----------------------------------------------------------------
+
+ if (solve_zsal) then ! default values
+
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc)
+ do iblk = 1, nblocks
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+ call icepack_init_zsalinity(nblyr=nblyr, ntrcr_o=ntrcr_o, &
+ Rayleigh_criteria = RayleighC, &
+ Rayleigh_real = RayleighR, &
+ trcrn_bgc = trcrn_bgc, &
+ nt_bgc_S = nt_bgc_S, &
+ ncat = ncat, &
+ sss = sss(i,j,iblk))
+ if (.not. restart_zsal) then
+ Rayleigh_real (i,j,iblk) = RayleighR
+ Rayleigh_criteria(i,j,iblk) = RayleighC
+ do n = 1,ncat
+ do k = 1, nblyr
+ trcrn (i,j,nt_bgc_S+k-1, n,iblk) = &
+ trcrn_bgc( nt_bgc_S+k-1-ntrcr_o,n)
+ enddo
+ enddo
+ endif
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+ endif ! solve_zsal
+
+ if (.not. solve_zsal) restart_zsal = .false.
+
+ !-----------------------------------------------------------------
+ ! biogeochemistry initialization
+ !-----------------------------------------------------------------
+
+ if (.not. restart_bgc) then
+
+ !-----------------------------------------------------------------
+ ! Initial Ocean Values if not coupled to the ocean bgc
+ !-----------------------------------------------------------------
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block)
+ do iblk = 1, nblocks
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+ call icepack_init_ocean_bio ( &
+ amm=amm (i,j, iblk), dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), &
+ algalN=algalN(i,j,:,iblk), doc=doc (i,j,:,iblk), dic=dic(i,j,:,iblk), &
+ don=don (i,j,:,iblk), fed=fed (i,j,:,iblk), fep=fep(i,j,:,iblk), &
+ hum=hum (i,j, iblk), nit=nit (i,j, iblk), sil=sil(i,j, iblk), &
+ zaeros=zaeros(i,j,:,iblk), &
+ max_dic = icepack_max_dic, max_don = icepack_max_don, &
+ max_fe = icepack_max_fe, max_aero = icepack_max_aero)
+ enddo ! i
+ enddo ! j
+
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call init_bgc_data(fed(:,:,1,:),fep(:,:,1,:)) ! input dFe from file
+ call get_forcing_bgc ! defines nit and sil
+
+ endif ! .not. restart
+
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block)
+ do iblk = 1, nblocks
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ call icepack_load_ocean_bio_array(max_nbtrcr=icepack_max_nbtrcr, &
+ max_algae=icepack_max_algae, max_don=icepack_max_don, &
+ max_doc=icepack_max_doc, max_fe=icepack_max_fe, &
+ max_dic=icepack_max_dic, max_aero=icepack_max_aero, &
+ nit =nit (i,j, iblk), amm=amm(i,j, iblk), sil =sil (i,j, iblk), &
+ dmsp=dmsp(i,j, iblk), dms=dms(i,j, iblk), algalN=algalN(i,j,:,iblk), &
+ doc =doc (i,j,:,iblk), don=don(i,j,:,iblk), dic =dic (i,j,:,iblk), &
+ fed =fed (i,j,:,iblk), fep=fep(i,j,:,iblk), zaeros=zaeros(i,j,:,iblk), &
+ hum=hum (i,j, iblk), ocean_bio_all=ocean_bio_all(i,j,:,iblk))
+
+ enddo ! i
+ enddo ! j
+
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ if (.not. restart_bgc) then
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc)
+ do iblk = 1, nblocks
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+ do n = 1, ncat
+ do k = 1, nilyr
+ sicen(k,n) = trcrn(i,j,nt_sice+k-1,n,iblk)
+ enddo
+ do k = ntrcr_o+1, ntrcr
+ trcrn_bgc(k-ntrcr_o,n) = trcrn(i,j,k,n,iblk)
+ enddo
+ enddo
+ call icepack_init_bgc(ncat=ncat, nblyr=nblyr, nilyr=nilyr, ntrcr_o=ntrcr_o, &
+ cgrid=cgrid, igrid=igrid, ntrcr=ntrcr, nbtrcr=nbtrcr, &
+ sicen=sicen(:,:), trcrn=trcrn_bgc(:,:), sss=sss(i,j, iblk), &
+ ocean_bio_all=ocean_bio_all(i,j,:,iblk))
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ endif ! .not. restart
+
+ !-----------------------------------------------------------------
+ ! read restart to complete BGC initialization
+ !-----------------------------------------------------------------
+
+ if (restart_zsal .or. restart_bgc) call read_restart_bgc
+
+ deallocate(trcrn_bgc)
+
+ end subroutine init_bgc
+
+!=======================================================================
+
+! Initialize brine height tracer
+
+ subroutine init_hbrine()
+
+ use ice_arrays_column, only: first_ice, bgrid, igrid, cgrid, &
+ icgrid, swgrid
+ use ice_state, only: trcrn
+
+ real (kind=dbl_kind) :: phi_snow
+ integer (kind=int_kind) :: nt_fbri
+ logical (kind=log_kind) :: tr_brine
+ character(len=*), parameter :: subname='(init_hbrine)'
+
+ call icepack_query_parameters(phi_snow_out=phi_snow)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ call icepack_init_hbrine(bgrid=bgrid, igrid=igrid, cgrid=cgrid, icgrid=icgrid, &
+ swgrid=swgrid, nblyr=nblyr, nilyr=nilyr, phi_snow=phi_snow)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_init_parameters(phi_snow_in=phi_snow)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ call icepack_query_tracer_flags(tr_brine_out=tr_brine)
+ call icepack_query_tracer_indices(nt_fbri_out=nt_fbri)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__,line= __LINE__)
+
+ first_ice(:,:,:,:) = .true.
+ if (tr_brine) trcrn(:,:,nt_fbri,:,:) = c1
+
+ end subroutine init_hbrine
+
+!=======================================================================
+
+! Namelist variables, set to default values; may be altered at run time
+!
+! author Elizabeth C. Hunke, LANL
+! Nicole Jeffery, LANL
+
+ subroutine input_zbgc
+
+ use ice_arrays_column, only: restore_bgc, optics_file, optics_file_fieldname
+ use ice_broadcast, only: broadcast_scalar
+ use ice_restart_column, only: restart_bgc, restart_zsal, &
+ restart_hbrine
+ use ice_restart_shared, only: restart
+
+ character (len=char_len) :: &
+ shortwave ! from icepack
+
+ logical (kind=log_kind) :: &
+ tr_brine, &
+ tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, &
+ tr_bgc_DMS, tr_bgc_PON, &
+ tr_bgc_N, tr_bgc_C, tr_bgc_chl, &
+ tr_bgc_DON, tr_bgc_Fe, tr_zaero, &
+ tr_bgc_hum, tr_aero
+
+ integer (kind=int_kind) :: &
+ ktherm
+
+ logical (kind=log_kind) :: &
+ solve_zsal, skl_bgc, z_tracers, scale_bgc, solve_zbgc, dEdd_algae, &
+ modal_aero
+
+ character (char_len) :: &
+ bgc_flux_type
+
+ integer (kind=int_kind) :: &
+ nml_error, & ! namelist i/o error flag
+ abort_flag
+
+ character(len=*), parameter :: subname='(input_zbgc)'
+
+ !-----------------------------------------------------------------
+ ! namelist variables
+ !-----------------------------------------------------------------
+
+ namelist /zbgc_nml/ &
+ tr_brine, restart_hbrine, tr_zaero, modal_aero, skl_bgc, &
+ z_tracers, dEdd_algae, solve_zbgc, bgc_flux_type, &
+ restore_bgc, restart_bgc, scale_bgc, solve_zsal, restart_zsal, &
+ tr_bgc_Nit, tr_bgc_C, tr_bgc_chl, tr_bgc_Am, tr_bgc_Sil, &
+ tr_bgc_DMS, tr_bgc_PON, tr_bgc_hum, tr_bgc_DON, tr_bgc_Fe, &
+ grid_o, grid_o_t, l_sk, grid_oS, optics_file, optics_file_fieldname, &
+ l_skS, phi_snow, initbio_frac, frazil_scav, &
+ ratio_Si2N_diatoms , ratio_Si2N_sp , ratio_Si2N_phaeo , &
+ ratio_S2N_diatoms , ratio_S2N_sp , ratio_S2N_phaeo , &
+ ratio_Fe2C_diatoms , ratio_Fe2C_sp , ratio_Fe2C_phaeo , &
+ ratio_Fe2N_diatoms , ratio_Fe2N_sp , ratio_Fe2N_phaeo , &
+ ratio_Fe2DON , ratio_Fe2DOC_s , ratio_Fe2DOC_l , &
+ fr_resp , tau_min , tau_max , &
+ algal_vel , R_dFe2dust , dustFe_sol , &
+ chlabs_diatoms , chlabs_sp , chlabs_phaeo , &
+ alpha2max_low_diatoms,alpha2max_low_sp , alpha2max_low_phaeo, &
+ beta2max_diatoms , beta2max_sp , beta2max_phaeo , &
+ mu_max_diatoms , mu_max_sp , mu_max_phaeo , &
+ grow_Tdep_diatoms , grow_Tdep_sp , grow_Tdep_phaeo , &
+ fr_graze_diatoms , fr_graze_sp , fr_graze_phaeo , &
+ mort_pre_diatoms , mort_pre_sp , mort_pre_phaeo , &
+ mort_Tdep_diatoms , mort_Tdep_sp , mort_Tdep_phaeo , &
+ k_exude_diatoms , k_exude_sp , k_exude_phaeo , &
+ K_Nit_diatoms , K_Nit_sp , K_Nit_phaeo , &
+ K_Am_diatoms , K_Am_sp , K_Am_phaeo , &
+ K_Sil_diatoms , K_Sil_sp , K_Sil_phaeo , &
+ K_Fe_diatoms , K_Fe_sp , K_Fe_phaeo , &
+ f_don_protein , kn_bac_protein , f_don_Am_protein , &
+ f_doc_s , f_doc_l , f_exude_s , &
+ f_exude_l , k_bac_s , k_bac_l , &
+ T_max , fsal , op_dep_min , &
+ fr_graze_s , fr_graze_e , fr_mort2min , &
+ fr_dFe , k_nitrif , t_iron_conv , &
+ max_loss , max_dfe_doc1 , fr_resp_s , &
+ y_sk_DMS , t_sk_conv , t_sk_ox , &
+ algaltype_diatoms , algaltype_sp , algaltype_phaeo , &
+ nitratetype , ammoniumtype , silicatetype , &
+ dmspptype , dmspdtype , humtype , &
+ doctype_s , doctype_l , dontype_protein , &
+ fedtype_1 , feptype_1 , zaerotype_bc1 , &
+ zaerotype_bc2 , zaerotype_dust1 , zaerotype_dust2 , &
+ zaerotype_dust3 , zaerotype_dust4 , ratio_C2N_diatoms , &
+ ratio_C2N_sp , ratio_C2N_phaeo , ratio_chl2N_diatoms, &
+ ratio_chl2N_sp , ratio_chl2N_phaeo , F_abs_chl_diatoms , &
+ F_abs_chl_sp , F_abs_chl_phaeo , ratio_C2N_proteins
+
+ !-----------------------------------------------------------------
+
+ abort_flag = 0
+
+ call icepack_query_tracer_flags(tr_aero_out=tr_aero)
+ call icepack_query_parameters(ktherm_out=ktherm, shortwave_out=shortwave)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! default values
+ !-----------------------------------------------------------------
+ tr_brine = .false. ! brine height differs from ice height
+ tr_zaero = .false. ! z aerosol tracers
+ modal_aero = .false. ! use modal aerosol treatment of aerosols
+ optics_file = 'unknown_optics_file' ! modal aerosol optics file
+ optics_file_fieldname = 'unknown_optics_fieldname' ! modal aerosol optics file fieldname
+ restore_bgc = .false. ! restore bgc if true
+ solve_zsal = .false. ! update salinity tracer profile from solve_S_dt
+ restart_bgc = .false. ! biogeochemistry restart
+ restart_zsal = .false. ! salinity restart
+ restart_hbrine = .false. ! hbrine restart
+ scale_bgc = .false. ! initial bgc tracers proportional to S
+ skl_bgc = .false. ! solve skeletal biochemistry
+ z_tracers = .false. ! solve vertically resolved tracers
+ dEdd_algae = .false. ! dynamic algae contributes to shortwave absorption
+ ! in delta-Eddington calculation
+ solve_zbgc = .false. ! turn on z layer biochemistry
+ tr_bgc_PON = .false. !---------------------------------------------
+ tr_bgc_Nit = .false. ! biogeochemistry (skl or zbgc)
+ tr_bgc_C = .false. ! if skl_bgc = .true. then skl
+ tr_bgc_chl = .false. ! if z_tracers = .true. then vertically resolved
+ tr_bgc_Sil = .false. ! if z_tracers + solve_zbgc = .true. then
+ tr_bgc_Am = .false. ! vertically resolved with reactions
+ tr_bgc_DMS = .false. !------------------------------------------------
+ tr_bgc_DON = .false. !
+ tr_bgc_hum = .false. !
+ tr_bgc_Fe = .false. !
+ tr_bgc_N = .true. !
+
+ ! brine height parameter
+ phi_snow = p5 ! snow porosity
+
+ ! skl biology parameters
+ bgc_flux_type = 'Jin2006'! type of ocean-ice poston velocity ('constant')
+
+ ! z biology parameters
+ grid_o = c5 ! for bottom flux
+ grid_o_t = c5 ! for top flux
+ l_sk = 7.0_dbl_kind ! characteristic diffusive scale (m)
+ initbio_frac = c1 ! fraction of ocean trcr concentration in bio trcrs
+ frazil_scav = c1 ! increase in initial bio tracer from ocean scavenging
+ ratio_Si2N_diatoms = 1.8_dbl_kind ! algal Si to N (mol/mol)
+ ratio_Si2N_sp = c0 ! diatoms, small plankton, phaeocystis
+ ratio_Si2N_phaeo = c0
+ ratio_S2N_diatoms = 0.03_dbl_kind ! algal S to N (mol/mol)
+ ratio_S2N_sp = 0.03_dbl_kind
+ ratio_S2N_phaeo = 0.03_dbl_kind
+ ratio_Fe2C_diatoms = 0.0033_dbl_kind ! algal Fe to C (umol/mol)
+ ratio_Fe2C_sp = 0.0033_dbl_kind
+ ratio_Fe2C_phaeo = p1
+ ratio_Fe2N_diatoms = 0.023_dbl_kind ! algal Fe to N (umol/mol)
+ ratio_Fe2N_sp = 0.023_dbl_kind
+ ratio_Fe2N_phaeo = 0.7_dbl_kind
+ ratio_Fe2DON = 0.023_dbl_kind ! Fe to N of DON (nmol/umol)
+ ratio_Fe2DOC_s = p1 ! Fe to C of DOC (nmol/umol) saccharids
+ ratio_Fe2DOC_l = 0.033_dbl_kind ! Fe to C of DOC (nmol/umol) lipids
+ fr_resp = 0.05_dbl_kind ! frac of algal growth lost due to respiration
+ tau_min = 5200.0_dbl_kind ! rapid mobile to stationary exchanges (s)
+ tau_max = 1.73e5_dbl_kind ! long time mobile to stationary exchanges (s)
+ algal_vel = 1.11e-8_dbl_kind! 0.5 cm/d(m/s) Lavoie 2005 1.5 cm/day
+ R_dFe2dust = 0.035_dbl_kind ! g/g (3.5% content) Tagliabue 2009
+ dustFe_sol = 0.005_dbl_kind ! solubility fraction
+ chlabs_diatoms = 0.03_dbl_kind ! chl absorption (1/m/(mg/m^3))
+ chlabs_sp = 0.01_dbl_kind
+ chlabs_phaeo = 0.05_dbl_kind
+ alpha2max_low_diatoms = 0.8_dbl_kind ! light limitation (1/(W/m^2))
+ alpha2max_low_sp = 0.67_dbl_kind
+ alpha2max_low_phaeo = 0.67_dbl_kind
+ beta2max_diatoms = 0.018_dbl_kind ! light inhibition (1/(W/m^2))
+ beta2max_sp = 0.0025_dbl_kind
+ beta2max_phaeo = 0.01_dbl_kind
+ mu_max_diatoms = 1.2_dbl_kind ! maximum growth rate (1/day)
+ mu_max_sp = 0.851_dbl_kind
+ mu_max_phaeo = 0.851_dbl_kind
+ grow_Tdep_diatoms = 0.06_dbl_kind ! Temperature dependence of growth (1/C)
+ grow_Tdep_sp = 0.06_dbl_kind
+ grow_Tdep_phaeo = 0.06_dbl_kind
+ fr_graze_diatoms = 0.01_dbl_kind ! Fraction grazed
+ fr_graze_sp = p1
+ fr_graze_phaeo = p1
+ mort_pre_diatoms = 0.007_dbl_kind! Mortality (1/day)
+ mort_pre_sp = 0.007_dbl_kind
+ mort_pre_phaeo = 0.007_dbl_kind
+ mort_Tdep_diatoms = 0.03_dbl_kind ! T dependence of mortality (1/C)
+ mort_Tdep_sp = 0.03_dbl_kind
+ mort_Tdep_phaeo = 0.03_dbl_kind
+ k_exude_diatoms = c0 ! algal exudation (1/d)
+ k_exude_sp = c0
+ k_exude_phaeo = c0
+ K_Nit_diatoms = c1 ! nitrate half saturation (mmol/m^3)
+ K_Nit_sp = c1
+ K_Nit_phaeo = c1
+ K_Am_diatoms = 0.3_dbl_kind ! ammonium half saturation (mmol/m^3)
+ K_Am_sp = 0.3_dbl_kind
+ K_Am_phaeo = 0.3_dbl_kind
+ K_Sil_diatoms = 4.0_dbl_kind ! silicate half saturation (mmol/m^3)
+ K_Sil_sp = c0
+ K_Sil_phaeo = c0
+ K_Fe_diatoms = c1 ! iron half saturation (nM)
+ K_Fe_sp = 0.2_dbl_kind
+ K_Fe_phaeo = p1
+ f_don_protein = 0.6_dbl_kind ! fraction of spilled grazing to proteins
+ kn_bac_protein = 0.03_dbl_kind ! Bacterial degredation of DON (1/d)
+ f_don_Am_protein = 0.25_dbl_kind ! fraction of remineralized DON to ammonium
+ f_doc_s = 0.4_dbl_kind ! fraction of mortality to DOC
+ f_doc_l = 0.4_dbl_kind
+ f_exude_s = c1 ! fraction of exudation to DOC
+ f_exude_l = c1
+ k_bac_s = 0.03_dbl_kind ! Bacterial degredation of DOC (1/d)
+ k_bac_l = 0.03_dbl_kind
+ T_max = c0 ! maximum temperature (C)
+ fsal = c1 ! Salinity limitation (ppt)
+ op_dep_min = p1 ! Light attenuates for optical depths exceeding min
+ fr_graze_s = p5 ! fraction of grazing spilled or slopped
+ fr_graze_e = p5 ! fraction of assimilation excreted
+ fr_mort2min = p5 ! fractionation of mortality to Am
+ fr_dFe = 0.3_dbl_kind ! fraction of remineralized nitrogen
+ ! (in units of algal iron)
+ k_nitrif = c0 ! nitrification rate (1/day)
+ t_iron_conv = 3065.0_dbl_kind ! desorption loss pFe to dFe (day)
+ max_loss = 0.9_dbl_kind ! restrict uptake to % of remaining value
+ max_dfe_doc1 = 0.2_dbl_kind ! max ratio of dFe to saccharides in the ice
+ !(nM Fe/muM C)
+ fr_resp_s = 0.75_dbl_kind ! DMSPd fraction of respiration loss as DMSPd
+ y_sk_DMS = p5 ! fraction conversion given high yield
+ t_sk_conv = 3.0_dbl_kind ! Stefels conversion time (d)
+ t_sk_ox = 10.0_dbl_kind ! DMS oxidation time (d)
+ algaltype_diatoms = c0 ! ------------------
+ algaltype_sp = p5 !
+ algaltype_phaeo = p5 !
+ nitratetype = -c1 ! mobility type between
+ ammoniumtype = c1 ! stationary <--> mobile
+ silicatetype = -c1 !
+ dmspptype = p5 !
+ dmspdtype = -c1 !
+ humtype = c1 !
+ doctype_s = p5 !
+ doctype_l = p5 !
+ dontype_protein = p5 !
+ fedtype_1 = p5 !
+ feptype_1 = p5 !
+ zaerotype_bc1 = c1 !
+ zaerotype_bc2 = c1 !
+ zaerotype_dust1 = c1 !
+ zaerotype_dust2 = c1 !
+ zaerotype_dust3 = c1 !
+ zaerotype_dust4 = c1 !--------------------
+ ratio_C2N_diatoms = 7.0_dbl_kind ! algal C to N ratio (mol/mol)
+ ratio_C2N_sp = 7.0_dbl_kind
+ ratio_C2N_phaeo = 7.0_dbl_kind
+ ratio_chl2N_diatoms= 2.1_dbl_kind ! algal chlorophyll to N ratio (mg/mmol)
+ ratio_chl2N_sp = 1.1_dbl_kind
+ ratio_chl2N_phaeo = 0.84_dbl_kind
+ F_abs_chl_diatoms = 2.0_dbl_kind ! scales absorbed radiation for dEdd
+ F_abs_chl_sp = 4.0_dbl_kind
+ F_abs_chl_phaeo = 5.0
+ ratio_C2N_proteins = 7.0_dbl_kind ! ratio of C to N in proteins (mol/mol)
+
+ ! z salinity parameters
+ grid_oS = c5 ! for bottom flux
+ l_skS = 7.0_dbl_kind ! characteristic diffusive scale (m)
+
+ !-----------------------------------------------------------------
+ ! read from input file
+ !-----------------------------------------------------------------
+
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' Reading zbgc_nml'
+
+ call get_fileunit(nu_nml)
+ open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error)
+ if (nml_error /= 0) then
+ call abort_ice(subname//'ERROR: zbgc_nml open file '// &
+ trim(nml_filename), &
+ file=__FILE__, line=__LINE__)
+ endif
+
+ nml_error = 1
+ do while (nml_error > 0)
+ read(nu_nml, nml=zbgc_nml,iostat=nml_error)
+ end do
+ if (nml_error /= 0) then
+ call abort_ice(subname//'ERROR: zbgc_nml reading ', &
+ file=__FILE__, line=__LINE__)
+ endif
+ close(nu_nml)
+ call release_fileunit(nu_nml)
+ endif
+
+ !-----------------------------------------------------------------
+ ! broadcast
+ !-----------------------------------------------------------------
+
+ call broadcast_scalar(solve_zsal, master_task)
+ call broadcast_scalar(restart_zsal, master_task)
+ call broadcast_scalar(tr_brine, master_task)
+ call broadcast_scalar(restart_hbrine, master_task)
+
+ call broadcast_scalar(phi_snow, master_task)
+ call broadcast_scalar(grid_oS, master_task)
+ call broadcast_scalar(l_skS, master_task)
+
+ call broadcast_scalar(solve_zbgc, master_task)
+ call broadcast_scalar(skl_bgc, master_task)
+ call broadcast_scalar(restart_bgc, master_task)
+ call broadcast_scalar(bgc_flux_type, master_task)
+ call broadcast_scalar(restore_bgc, master_task)
+ call broadcast_scalar(tr_bgc_N, master_task)
+ call broadcast_scalar(tr_bgc_C, master_task)
+ call broadcast_scalar(tr_bgc_chl, master_task)
+ call broadcast_scalar(tr_bgc_Nit, master_task)
+ call broadcast_scalar(tr_bgc_Am, master_task)
+ call broadcast_scalar(tr_bgc_Sil, master_task)
+ call broadcast_scalar(tr_bgc_hum, master_task)
+ call broadcast_scalar(tr_bgc_DMS, master_task)
+ call broadcast_scalar(tr_bgc_PON, master_task)
+ call broadcast_scalar(tr_bgc_DON, master_task)
+ call broadcast_scalar(tr_bgc_Fe, master_task)
+
+ call broadcast_scalar(z_tracers, master_task)
+ call broadcast_scalar(tr_zaero, master_task)
+ call broadcast_scalar(dEdd_algae, master_task)
+ call broadcast_scalar(modal_aero, master_task)
+ call broadcast_scalar(optics_file, master_task)
+ call broadcast_scalar(optics_file_fieldname, master_task)
+ call broadcast_scalar(grid_o, master_task)
+ call broadcast_scalar(grid_o_t, master_task)
+ call broadcast_scalar(l_sk, master_task)
+ call broadcast_scalar(scale_bgc, master_task)
+ call broadcast_scalar(initbio_frac, master_task)
+ call broadcast_scalar(frazil_scav, master_task)
+ call broadcast_scalar(ratio_Si2N_diatoms, master_task)
+ call broadcast_scalar(ratio_Si2N_sp, master_task)
+ call broadcast_scalar(ratio_Si2N_phaeo, master_task)
+ call broadcast_scalar(ratio_S2N_diatoms, master_task)
+ call broadcast_scalar(ratio_S2N_sp, master_task)
+ call broadcast_scalar(ratio_S2N_phaeo, master_task)
+ call broadcast_scalar(ratio_Fe2C_diatoms, master_task)
+ call broadcast_scalar(ratio_Fe2C_sp, master_task)
+ call broadcast_scalar(ratio_Fe2C_phaeo, master_task)
+ call broadcast_scalar(ratio_Fe2N_diatoms, master_task)
+ call broadcast_scalar(ratio_Fe2N_sp, master_task)
+ call broadcast_scalar(ratio_Fe2N_phaeo, master_task)
+ call broadcast_scalar(ratio_Fe2DON , master_task)
+ call broadcast_scalar(ratio_Fe2DOC_s , master_task)
+ call broadcast_scalar(ratio_Fe2DOC_l , master_task)
+ call broadcast_scalar(fr_resp , master_task)
+ call broadcast_scalar(tau_min , master_task)
+ call broadcast_scalar(tau_max , master_task)
+ call broadcast_scalar(algal_vel , master_task)
+ call broadcast_scalar(R_dFe2dust , master_task)
+ call broadcast_scalar(dustFe_sol , master_task)
+ call broadcast_scalar(chlabs_diatoms , master_task)
+ call broadcast_scalar(chlabs_sp , master_task)
+ call broadcast_scalar(chlabs_phaeo , master_task)
+ call broadcast_scalar(alpha2max_low_diatoms , master_task)
+ call broadcast_scalar(alpha2max_low_sp , master_task)
+ call broadcast_scalar(alpha2max_low_phaeo , master_task)
+ call broadcast_scalar(beta2max_diatoms , master_task)
+ call broadcast_scalar(beta2max_sp , master_task)
+ call broadcast_scalar(beta2max_phaeo , master_task)
+ call broadcast_scalar(mu_max_diatoms , master_task)
+ call broadcast_scalar(mu_max_sp , master_task)
+ call broadcast_scalar(mu_max_phaeo , master_task)
+ call broadcast_scalar(grow_Tdep_diatoms, master_task)
+ call broadcast_scalar(grow_Tdep_sp , master_task)
+ call broadcast_scalar(grow_Tdep_phaeo , master_task)
+ call broadcast_scalar(fr_graze_diatoms , master_task)
+ call broadcast_scalar(fr_graze_sp , master_task)
+ call broadcast_scalar(fr_graze_phaeo , master_task)
+ call broadcast_scalar(mort_pre_diatoms , master_task)
+ call broadcast_scalar(mort_pre_sp , master_task)
+ call broadcast_scalar(mort_pre_phaeo , master_task)
+ call broadcast_scalar(mort_Tdep_diatoms, master_task)
+ call broadcast_scalar(mort_Tdep_sp , master_task)
+ call broadcast_scalar(mort_Tdep_phaeo , master_task)
+ call broadcast_scalar(k_exude_diatoms , master_task)
+ call broadcast_scalar(k_exude_sp , master_task)
+ call broadcast_scalar(k_exude_phaeo , master_task)
+ call broadcast_scalar(K_Nit_diatoms , master_task)
+ call broadcast_scalar(K_Nit_sp , master_task)
+ call broadcast_scalar(K_Nit_phaeo , master_task)
+ call broadcast_scalar(K_Am_diatoms , master_task)
+ call broadcast_scalar(K_Am_sp , master_task)
+ call broadcast_scalar(K_Am_phaeo , master_task)
+ call broadcast_scalar(K_Sil_diatoms , master_task)
+ call broadcast_scalar(K_Sil_sp , master_task)
+ call broadcast_scalar(K_Sil_phaeo , master_task)
+ call broadcast_scalar(K_Fe_diatoms , master_task)
+ call broadcast_scalar(K_Fe_sp , master_task)
+ call broadcast_scalar(K_Fe_phaeo , master_task)
+ call broadcast_scalar(f_don_protein , master_task)
+ call broadcast_scalar(kn_bac_protein , master_task)
+ call broadcast_scalar(f_don_Am_protein , master_task)
+ call broadcast_scalar(f_doc_s , master_task)
+ call broadcast_scalar(f_doc_l , master_task)
+ call broadcast_scalar(f_exude_s , master_task)
+ call broadcast_scalar(f_exude_l , master_task)
+ call broadcast_scalar(k_bac_s , master_task)
+ call broadcast_scalar(k_bac_l , master_task)
+ call broadcast_scalar(T_max , master_task)
+ call broadcast_scalar(fsal , master_task)
+ call broadcast_scalar(op_dep_min , master_task)
+ call broadcast_scalar(fr_graze_s , master_task)
+ call broadcast_scalar(fr_graze_e , master_task)
+ call broadcast_scalar(fr_mort2min , master_task)
+ call broadcast_scalar(fr_dFe , master_task)
+ call broadcast_scalar(k_nitrif , master_task)
+ call broadcast_scalar(t_iron_conv , master_task)
+ call broadcast_scalar(max_loss , master_task)
+ call broadcast_scalar(max_dfe_doc1 , master_task)
+ call broadcast_scalar(fr_resp_s , master_task)
+ call broadcast_scalar(y_sk_DMS , master_task)
+ call broadcast_scalar(t_sk_conv , master_task)
+ call broadcast_scalar(t_sk_ox , master_task)
+ call broadcast_scalar(algaltype_diatoms, master_task)
+ call broadcast_scalar(algaltype_sp , master_task)
+ call broadcast_scalar(algaltype_phaeo , master_task)
+ call broadcast_scalar(nitratetype , master_task)
+ call broadcast_scalar(ammoniumtype , master_task)
+ call broadcast_scalar(silicatetype , master_task)
+ call broadcast_scalar(dmspptype , master_task)
+ call broadcast_scalar(dmspdtype , master_task)
+ call broadcast_scalar(humtype , master_task)
+ call broadcast_scalar(doctype_s , master_task)
+ call broadcast_scalar(doctype_l , master_task)
+ call broadcast_scalar(dontype_protein , master_task)
+ call broadcast_scalar(fedtype_1 , master_task)
+ call broadcast_scalar(feptype_1 , master_task)
+ call broadcast_scalar(zaerotype_bc1 , master_task)
+ call broadcast_scalar(zaerotype_bc2 , master_task)
+ call broadcast_scalar(zaerotype_dust1 , master_task)
+ call broadcast_scalar(zaerotype_dust2 , master_task)
+ call broadcast_scalar(zaerotype_dust3 , master_task)
+ call broadcast_scalar(zaerotype_dust4 , master_task)
+ call broadcast_scalar(ratio_C2N_diatoms , master_task)
+ call broadcast_scalar(ratio_C2N_sp , master_task)
+ call broadcast_scalar(ratio_C2N_phaeo , master_task)
+ call broadcast_scalar(ratio_chl2N_diatoms, master_task)
+ call broadcast_scalar(ratio_chl2N_sp , master_task)
+ call broadcast_scalar(ratio_chl2N_phaeo , master_task)
+ call broadcast_scalar(F_abs_chl_diatoms , master_task)
+ call broadcast_scalar(F_abs_chl_sp , master_task)
+ call broadcast_scalar(F_abs_chl_phaeo , master_task)
+ call broadcast_scalar(ratio_C2N_proteins , master_task)
+
+ !-----------------------------------------------------------------
+ ! zsalinity and brine
+ !-----------------------------------------------------------------
+
+ if (.not.restart) then
+ if (my_task == master_task) &
+ write(nu_diag,*) subname//' WARNING: restart = false, setting bgc restart flags to false'
+ restart_bgc = .false.
+ restart_hbrine = .false.
+ restart_zsal = .false.
+ endif
+
+ if (solve_zsal) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: solve_zsal=T deprecated'
+ endif
+ abort_flag = 101
+ endif
+
+#ifdef UNDEPRECATE_ZSAL
+ if (solve_zsal .and. nblyr < 1) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: solve_zsal=T but 0 zsalinity tracers'
+ endif
+ abort_flag = 101
+ endif
+
+ if (solve_zsal .and. ((.not. tr_brine) .or. (ktherm /= 1))) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: solve_zsal needs tr_brine=T and ktherm=1'
+ endif
+ abort_flag = 102
+ endif
+#endif
+
+ if (tr_brine .and. nblyr < 1 ) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: tr_brine=T but no biology layers compiled'
+ endif
+ abort_flag = 103
+ endif
+
+ !-----------------------------------------------------------------
+ ! biogeochemistry
+ !-----------------------------------------------------------------
+
+ if (.not. tr_brine) then
+ if (solve_zbgc) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: tr_brine = F and solve_zbgc = T'
+ endif
+ abort_flag = 104
+ endif
+ if (tr_zaero) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: tr_brine = F and tr_zaero = T'
+ endif
+ abort_flag = 105
+ endif
+ endif
+
+ if ((skl_bgc .AND. solve_zbgc) .or. (skl_bgc .AND. z_tracers)) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: skl_bgc and solve_zbgc or z_tracers are both true'
+ endif
+ abort_flag = 106
+ endif
+
+ if (skl_bgc .AND. tr_zaero) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: skl_bgc does not use vertical tracers'
+ endif
+ abort_flag = 107
+ endif
+
+ if (dEdd_algae .AND. trim(shortwave) /= 'dEdd') then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: dEdd_algae = T but shortwave /= dEdd'
+ endif
+ abort_flag = 108
+ endif
+
+ if (dEdd_algae .AND. (.NOT. tr_bgc_N) .AND. (.NOT. tr_zaero)) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: need tr_bgc_N or tr_zaero for dEdd_algae'
+ endif
+ abort_flag = 109
+ endif
+
+ if (modal_aero .AND. (.NOT. tr_zaero) .AND. (.NOT. tr_aero)) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: modal_aero T with tr_zaero and tr_aero'
+ endif
+ abort_flag = 110
+ endif
+
+ if (modal_aero .AND. trim(shortwave) /= 'dEdd') then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname,' ERROR: modal_aero = T but shortwave /= dEdd'
+ endif
+ abort_flag = 111
+ endif
+ if (n_algae > icepack_max_algae) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of algal types exceeds icepack_max_algae'
+ endif
+ abort_flag = 112
+ endif
+ if (n_doc > icepack_max_doc) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of doc types exceeds icepack_max_doc'
+ endif
+ abort_flag = 113
+ endif
+ if (n_dic > icepack_max_doc) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of dic types exceeds icepack_max_dic'
+ endif
+ abort_flag = 114
+ endif
+ if (n_don > icepack_max_don) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of don types exceeds icepack_max_don'
+ endif
+ abort_flag = 115
+ endif
+ if (n_fed > icepack_max_fe ) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of dissolved fe types exceeds icepack_max_fe '
+ endif
+ abort_flag = 116
+ endif
+ if (n_fep > icepack_max_fe ) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of particulate fe types exceeds icepack_max_fe '
+ endif
+ abort_flag = 117
+ endif
+
+ if (n_algae == 0 .and. skl_bgc) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: skl_bgc=T but 0 bgc or algal tracers compiled'
+ endif
+ abort_flag = 118
+ endif
+
+ if (n_algae == 0 .and. solve_zbgc) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: solve_zbgc=T but 0 zbgc or algal tracers compiled'
+ endif
+ abort_flag = 119
+ endif
+
+ if (solve_zbgc .and. .not. z_tracers) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: solve_zbgc=T but not z_tracers'
+ endif
+ abort_flag = 120
+ endif
+
+ if (skl_bgc .or. solve_zbgc) then
+ if (.not. tr_bgc_N) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: tr_bgc_N must be on for bgc'
+ endif
+ abort_flag = 121
+ endif
+ if (.not. tr_bgc_Nit) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: tr_bgc_Nit must be on for bgc'
+ endif
+ abort_flag = 122
+ endif
+ else
+ ! tcraig, allow bgc to be turned off in this case?
+ tr_bgc_N = .false.
+ tr_bgc_C = .false.
+ tr_bgc_chl = .false.
+ tr_bgc_Nit = .false.
+ tr_bgc_Am = .false.
+ tr_bgc_Sil = .false.
+ tr_bgc_hum = .false.
+ tr_bgc_DMS = .false.
+ tr_bgc_PON = .false.
+ tr_bgc_DON = .false.
+ tr_bgc_Fe = .false.
+ endif
+
+ !-----------------------------------------------------------------
+ ! z layer aerosols
+ !-----------------------------------------------------------------
+ if (tr_zaero .and. .not. z_tracers) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: tr_zaero and not z_tracers'
+ endif
+ abort_flag = 123
+ endif
+
+ if (n_zaero > icepack_max_aero) then
+ if (my_task == master_task) then
+ write(nu_diag,*) subname//'ERROR: number of z aerosols exceeds icepack_max_aero'
+ endif
+ abort_flag = 124
+ endif
+
+ !-----------------------------------------------------------------
+ ! output
+ !-----------------------------------------------------------------
+
+ if (my_task == master_task) then
+ write(nu_diag,1010) ' tr_brine = ', tr_brine
+ if (tr_brine) then
+ write(nu_diag,1010) ' restart_hbrine = ', restart_hbrine
+ write(nu_diag,1005) ' phi_snow = ', phi_snow
+ endif
+ write(nu_diag,1010) ' solve_zsal = ', solve_zsal
+ if (solve_zsal) then
+ write(nu_diag,1010) ' restart_zsal = ', restart_zsal
+ write(nu_diag,1000) ' grid_oS = ', grid_oS
+ write(nu_diag,1005) ' l_skS = ', l_skS
+ endif
+
+ write(nu_diag,1010) ' skl_bgc = ', skl_bgc
+ write(nu_diag,1010) ' restart_bgc = ', restart_bgc
+ write(nu_diag,1010) ' tr_bgc_N = ', tr_bgc_N
+ write(nu_diag,1010) ' tr_bgc_C = ', tr_bgc_C
+ write(nu_diag,1010) ' tr_bgc_chl = ', tr_bgc_chl
+ write(nu_diag,1010) ' tr_bgc_Nit = ', tr_bgc_Nit
+ write(nu_diag,1010) ' tr_bgc_Am = ', tr_bgc_Am
+ write(nu_diag,1010) ' tr_bgc_Sil = ', tr_bgc_Sil
+ write(nu_diag,1010) ' tr_bgc_hum = ', tr_bgc_hum
+ write(nu_diag,1010) ' tr_bgc_DMS = ', tr_bgc_DMS
+ write(nu_diag,1010) ' tr_bgc_PON = ', tr_bgc_PON
+ write(nu_diag,1010) ' tr_bgc_DON = ', tr_bgc_DON
+ write(nu_diag,1010) ' tr_bgc_Fe = ', tr_bgc_Fe
+ write(nu_diag,1020) ' n_aero = ', n_aero
+ write(nu_diag,1020) ' n_zaero = ', n_zaero
+ write(nu_diag,1020) ' n_algae = ', n_algae
+ write(nu_diag,1020) ' n_doc = ', n_doc
+ write(nu_diag,1020) ' n_dic = ', n_dic
+ write(nu_diag,1020) ' n_don = ', n_don
+ write(nu_diag,1020) ' n_fed = ', n_fed
+ write(nu_diag,1020) ' n_fep = ', n_fep
+
+ if (skl_bgc) then
+
+ write(nu_diag,1030) ' bgc_flux_type = ', bgc_flux_type
+ write(nu_diag,1010) ' restore_bgc = ', restore_bgc
+
+ elseif (z_tracers) then
+
+ write(nu_diag,1010) ' dEdd_algae = ', dEdd_algae
+ write(nu_diag,1010) ' modal_aero = ', modal_aero
+ write(nu_diag,1010) ' scale_bgc = ', scale_bgc
+ write(nu_diag,1010) ' solve_zbgc = ', solve_zbgc
+ write(nu_diag,1010) ' tr_zaero = ', tr_zaero
+ write(nu_diag,1020) ' number of aerosols = ', n_zaero
+ write(nu_diag,1031) ' optics_file = ', trim(optics_file)
+ write(nu_diag,1031) ' optics_file_fieldname = ', trim(optics_file_fieldname)
+ ! bio parameters
+ write(nu_diag,1000) ' grid_o = ', grid_o
+ write(nu_diag,1000) ' grid_o_t = ', grid_o_t
+ write(nu_diag,1005) ' l_sk = ', l_sk
+ write(nu_diag,1000) ' initbio_frac = ', initbio_frac
+ write(nu_diag,1000) ' frazil_scav = ', frazil_scav
+
+ endif ! skl_bgc or solve_bgc
+ endif
+
+ !-----------------------------------------------------------------
+ ! abort if abort flag is set
+ !-----------------------------------------------------------------
+
+ if (abort_flag /= 0) then
+ call flush_fileunit(nu_diag)
+ endif
+ call ice_barrier()
+ if (abort_flag /= 0) then
+ write(nu_diag,*) subname,' ERROR: abort_flag=',abort_flag
+ call abort_ice (subname//' ABORTING on input ERRORS', &
+ file=__FILE__, line=__LINE__)
+ endif
+
+ !-----------------------------------------------------------------
+ ! set values in icepack
+ !-----------------------------------------------------------------
+
+ call icepack_init_parameters( &
+ ktherm_in=ktherm, shortwave_in=shortwave, solve_zsal_in=solve_zsal, &
+ skl_bgc_in=skl_bgc, z_tracers_in=z_tracers, scale_bgc_in=scale_bgc, &
+ dEdd_algae_in=dEdd_algae, &
+ solve_zbgc_in=solve_zbgc, &
+ bgc_flux_type_in=bgc_flux_type, grid_o_in=grid_o, l_sk_in=l_sk, &
+ initbio_frac_in=initbio_frac, &
+ grid_oS_in=grid_oS, l_skS_in=l_skS, &
+ phi_snow_in=phi_snow, frazil_scav_in = frazil_scav, &
+ modal_aero_in=modal_aero)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_init_tracer_flags(tr_brine_in=tr_brine, &
+ tr_bgc_Nit_in=tr_bgc_Nit, tr_bgc_Am_in =tr_bgc_Am, tr_bgc_Sil_in=tr_bgc_Sil, &
+ tr_bgc_DMS_in=tr_bgc_DMS, tr_bgc_PON_in=tr_bgc_PON, &
+ tr_bgc_N_in =tr_bgc_N, tr_bgc_C_in =tr_bgc_C, tr_bgc_chl_in=tr_bgc_chl, &
+ tr_bgc_DON_in=tr_bgc_DON, tr_bgc_Fe_in =tr_bgc_Fe, tr_zaero_in =tr_zaero, &
+ tr_bgc_hum_in=tr_bgc_hum)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements
+ 1005 format (a30,2x,f9.6) ! float
+ 1010 format (a30,2x,l6) ! logical
+ 1020 format (a30,2x,i6) ! integer
+ 1030 format (a30, a8) ! character
+ 1031 format (a30, a ) ! character
+
+ end subroutine input_zbgc
+
+!=======================================================================
+
+! Count and index tracers
+!
+! author Elizabeth C. Hunke, LANL
+
+ subroutine count_tracers
+
+ use ice_domain_size, only: nilyr, nslyr, nblyr, nfsd, n_iso, &
+ n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ k, mm , & ! loop index
+ nk , & ! layer index
+ nk_bgc ! layer index
+
+ integer (kind=int_kind) :: ntrcr
+ logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_fsd
+ logical (kind=log_kind) :: tr_snow
+ logical (kind=log_kind) :: tr_iso, tr_pond_lvl, tr_pond_topo
+ integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY
+ integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero
+ integer (kind=int_kind) :: nt_fsd, nt_isosno, nt_isoice
+ integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw
+
+ integer (kind=int_kind) :: &
+ nbtrcr, nbtrcr_sw, &
+ ntrcr_o, nt_fbri, &
+ nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, &
+ nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, &
+ nt_bgc_DMSPp, nt_bgc_DMSPd, &
+ nt_zbgc_frac, nlt_chl_sw, &
+ nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, &
+ nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, &
+ nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero_sw ! points to aerosol in trcrn_sw
+
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nlt_bgc_N , & ! algae
+ nlt_bgc_chl
+
+ integer (kind=int_kind), dimension(icepack_max_doc) :: &
+ nlt_bgc_DOC ! disolved organic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_don) :: &
+ nlt_bgc_DON !
+
+ integer (kind=int_kind), dimension(icepack_max_dic) :: &
+ nlt_bgc_DIC ! disolved inorganic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_fe) :: &
+ nlt_bgc_Fed , & !
+ nlt_bgc_Fep !
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero ! non-reacting layer aerosols
+
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nt_bgc_N , & ! diatoms, phaeocystis, pico/small
+ nt_bgc_chl ! diatoms, phaeocystis, pico/small
+
+ integer (kind=int_kind), dimension(icepack_max_doc) :: &
+ nt_bgc_DOC ! dissolved organic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_don) :: &
+ nt_bgc_DON ! dissolved organic nitrogen
+
+ integer (kind=int_kind), dimension(icepack_max_dic) :: &
+ nt_bgc_DIC ! dissolved inorganic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_fe) :: &
+ nt_bgc_Fed, & ! dissolved iron
+ nt_bgc_Fep ! particulate iron
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nt_zaero ! black carbon and other aerosols
+
+ logical (kind=log_kind) :: &
+ tr_brine, &
+ tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, &
+ tr_bgc_DMS, tr_bgc_PON, &
+ tr_bgc_N, tr_bgc_C, tr_bgc_chl, &
+ tr_bgc_DON, tr_bgc_Fe, tr_zaero, &
+ tr_bgc_hum
+
+ logical (kind=log_kind) :: &
+ solve_zsal, skl_bgc, z_tracers
+
+ character(len=*), parameter :: subname='(count_tracers)'
+
+ !-----------------------------------------------------------------
+
+ call icepack_query_parameters( &
+ solve_zsal_out=solve_zsal, &
+ skl_bgc_out=skl_bgc, z_tracers_out=z_tracers)
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, &
+ tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_pond_out=tr_pond, &
+ tr_pond_lvl_out=tr_pond_lvl, &
+ tr_pond_topo_out=tr_pond_topo, tr_brine_out=tr_brine, tr_fsd_out=tr_fsd, &
+ tr_snow_out=tr_snow, tr_iso_out=tr_iso, &
+ tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out =tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, &
+ tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, &
+ tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, &
+ tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out =tr_bgc_Fe, tr_zaero_out =tr_zaero, &
+ tr_bgc_hum_out=tr_bgc_hum)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ ntrcr = 0
+
+ ntrcr = ntrcr + 1 ! count tracers, starting with Tsfc = 1
+ nt_Tsfc = ntrcr ! index tracers, starting with Tsfc = 1
+
+ nt_qice = ntrcr + 1
+ ntrcr = ntrcr + nilyr ! qice in nilyr layers
+
+ nt_qsno = ntrcr + 1
+ ntrcr = ntrcr + nslyr ! qsno in nslyr layers
+
+ nt_sice = ntrcr + 1
+ ntrcr = ntrcr + nilyr ! sice in nilyr layers
+
+ nt_iage = 0
+ if (tr_iage) then
+ ntrcr = ntrcr + 1
+ nt_iage = ntrcr ! chronological ice age
+ endif
+
+ nt_FY = 0
+ if (tr_FY) then
+ ntrcr = ntrcr + 1
+ nt_FY = ntrcr ! area of first year ice
+ endif
+
+ nt_alvl = 0
+ nt_vlvl = 0
+ if (tr_lvl) then
+ ntrcr = ntrcr + 1
+ nt_alvl = ntrcr
+ ntrcr = ntrcr + 1
+ nt_vlvl = ntrcr
+ endif
+
+ nt_apnd = 0
+ nt_hpnd = 0
+ nt_ipnd = 0
+ if (tr_pond) then ! all explicit melt pond schemes
+ ntrcr = ntrcr + 1
+ nt_apnd = ntrcr
+ ntrcr = ntrcr + 1
+ nt_hpnd = ntrcr
+ if (tr_pond_lvl) then
+ ntrcr = ntrcr + 1 ! refrozen pond ice lid thickness
+ nt_ipnd = ntrcr ! on level-ice ponds (if frzpnd='hlid')
+ endif
+ if (tr_pond_topo) then
+ ntrcr = ntrcr + 1 !
+ nt_ipnd = ntrcr ! refrozen pond ice lid thickness
+ endif
+ endif
+
+ nt_smice = 0
+ nt_smliq = 0
+ nt_rhos = 0
+ nt_rsnw = 0
+ if (tr_snow) then
+ nt_smice = ntrcr + 1
+ ntrcr = ntrcr + nslyr ! mass of ice in nslyr snow layers
+ nt_smliq = ntrcr + 1
+ ntrcr = ntrcr + nslyr ! mass of liquid in nslyr snow layers
+ nt_rhos = ntrcr + 1
+ ntrcr = ntrcr + nslyr ! snow density in nslyr layers
+ nt_rsnw = ntrcr + 1
+ ntrcr = ntrcr + nslyr ! snow grain radius in nslyr layers
+ endif
+
+ nt_fsd = 0
+ if (tr_fsd) then
+ nt_fsd = ntrcr + 1 ! floe size distribution
+ ntrcr = ntrcr + nfsd
+ endif
+
+ nt_isosno = 0
+ nt_isoice = 0
+ if (tr_iso) then
+ nt_isosno = ntrcr + 1 ! isotopes in snow
+ ntrcr = ntrcr + n_iso
+ nt_isoice = ntrcr + 1 ! isotopes in ice
+ ntrcr = ntrcr + n_iso
+ endif
+
+ nt_aero = 0
+ if (tr_aero) then
+ nt_aero = ntrcr + 1
+ ntrcr = ntrcr + 4*n_aero ! 4 dEdd layers, n_aero species
+ else
+!tcx, modify code so we don't have to reset n_aero here
+ n_aero = 0 !echmod - this is not getting set correctly (overwritten later?)
+ endif
+
+ !-----------------------------------------------------------------
+ ! initialize zbgc tracer indices
+ !-----------------------------------------------------------------
+
+ nbtrcr = 0
+ nbtrcr_sw = 0
+ nt_zbgc_frac = 0
+
+ ! vectors of size icepack_max_algae
+ nlt_bgc_N(:) = 0
+ nlt_bgc_chl(:) = 0
+ nt_bgc_N(:) = 0
+ nt_bgc_chl(:) = 0
+
+ ! vectors of size icepack_max_dic
+ nlt_bgc_DIC(:) = 0
+ nt_bgc_DIC(:) = 0
+
+ ! vectors of size icepack_max_doc
+ nlt_bgc_DOC(:) = 0
+ nt_bgc_DOC(:) = 0
+
+ ! vectors of size icepack_max_don
+ nlt_bgc_DON(:) = 0
+ nt_bgc_DON(:) = 0
+
+ ! vectors of size icepack_max_fe
+ nlt_bgc_Fed(:) = 0
+ nlt_bgc_Fep(:) = 0
+ nt_bgc_Fed(:) = 0
+ nt_bgc_Fep(:) = 0
+
+ ! vectors of size icepack_max_aero
+ nlt_zaero(:) = 0
+ nlt_zaero_sw(:) = 0
+ nt_zaero(:) = 0
+
+ nlt_bgc_Nit = 0
+ nlt_bgc_Am = 0
+ nlt_bgc_Sil = 0
+ nlt_bgc_DMSPp = 0
+ nlt_bgc_DMSPd = 0
+ nlt_bgc_DMS = 0
+ nlt_bgc_PON = 0
+ nlt_bgc_hum = 0
+! nlt_bgc_C = 0
+ nlt_chl_sw = 0
+
+ nt_bgc_Nit = 0
+ nt_bgc_Am = 0
+ nt_bgc_Sil = 0
+ nt_bgc_DMSPp = 0
+ nt_bgc_DMSPd = 0
+ nt_bgc_DMS = 0
+ nt_bgc_PON = 0
+ nt_bgc_hum = 0
+! nt_bgc_C = 0
+
+ ntrcr_o = ntrcr
+ nt_fbri = 0
+ if (tr_brine) then
+ nt_fbri = ntrcr + 1 ! ice volume fraction with salt
+ ntrcr = ntrcr + 1
+ endif
+
+ nt_bgc_S = 0
+ if (solve_zsal) then ! .true. only if tr_brine = .true.
+ nt_bgc_S = ntrcr + 1
+ ntrcr = ntrcr + nblyr
+ endif
+
+ if (skl_bgc .or. z_tracers) then
+
+ if (skl_bgc) then
+ nk = 1
+ elseif (z_tracers) then ! defined on nblyr+1 in ice
+ ! and 2 snow layers (snow surface + interior)
+ nk = nblyr + 1
+ endif ! skl_bgc or z_tracers
+ nk_bgc = nk ! number of bgc layers in ice
+ if (nk > 1) nk_bgc = nk + 2 ! number of bgc layers in ice and snow
+
+ !-----------------------------------------------------------------
+ ! count tracers and assign tracer indices
+ !-----------------------------------------------------------------
+
+ if (tr_bgc_N) then
+ do mm = 1, n_algae
+ nt_bgc_N(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_N(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_bgc_N
+
+ if (tr_bgc_Nit) then
+ nt_bgc_Nit = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_Nit = nbtrcr
+ endif ! tr_bgc_Nit
+
+ if (tr_bgc_C) then
+ !
+ ! Algal C is not yet distinct from algal N
+ ! * Reqires exudation and/or changing C:N ratios
+ ! for implementation
+ !
+ ! do mm = 1,n_algae
+ ! nt_bgc_C(mm) = ntrcr + 1
+ ! do k = 1, nk_bgc
+ ! ntrcr = ntrcr + 1
+ ! enddo
+ ! nbtrcr = nbtrcr + 1
+ ! nlt_bgc_C(mm) = nbtrcr
+ ! enddo ! mm
+
+ do mm = 1, n_doc
+ nt_bgc_DOC(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DOC(mm) = nbtrcr
+ enddo ! mm
+ do mm = 1, n_dic
+ nt_bgc_DIC(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DIC(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_bgc_C
+
+ if (tr_bgc_chl) then
+ do mm = 1, n_algae
+ nt_bgc_chl(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_chl(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_bgc_chl
+
+ if (tr_bgc_Am) then
+ nt_bgc_Am = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_Am = nbtrcr
+ endif
+ if (tr_bgc_Sil) then
+ nt_bgc_Sil = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_Sil = nbtrcr
+ endif
+
+ if (tr_bgc_DMS) then ! all together
+ nt_bgc_DMSPp = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DMSPp = nbtrcr
+
+ nt_bgc_DMSPd = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DMSPd = nbtrcr
+
+ nt_bgc_DMS = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DMS = nbtrcr
+ endif
+
+ if (tr_bgc_PON) then
+ nt_bgc_PON = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_PON = nbtrcr
+ endif
+
+ if (tr_bgc_DON) then
+ do mm = 1, n_don
+ nt_bgc_DON(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_DON(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_bgc_DON
+
+ if (tr_bgc_Fe) then
+ do mm = 1, n_fed
+ nt_bgc_Fed(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_Fed(mm) = nbtrcr
+ enddo ! mm
+ do mm = 1, n_fep
+ nt_bgc_Fep(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_Fep(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_bgc_Fe
+
+ if (tr_bgc_hum) then
+ nt_bgc_hum = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_bgc_hum = nbtrcr
+ endif
+
+ endif ! skl_bgc .or. z_tracers
+
+ if (z_tracers) then ! defined on nblyr+1 in ice
+ ! and 2 snow layers (snow surface + interior)
+ ! z layer aerosols
+ if (tr_zaero) then
+ do mm = 1, n_zaero
+ nt_zaero(mm) = ntrcr + 1
+ do k = 1, nk_bgc
+ ntrcr = ntrcr + 1
+ enddo
+ nbtrcr = nbtrcr + 1
+ nlt_zaero(mm) = nbtrcr
+ enddo ! mm
+ endif ! tr_zaero
+
+ if (nbtrcr > 0) then
+ nt_zbgc_frac = ntrcr + 1
+ ntrcr = ntrcr + nbtrcr
+ endif
+ endif ! z_tracers
+
+!tcx, +1 here is the unused tracer, want to get rid of it
+ ntrcr = ntrcr + 1
+
+!tcx, reset unused tracer index, eventually get rid of it.
+ if (nt_iage <= 0) nt_iage = ntrcr
+ if (nt_FY <= 0) nt_FY = ntrcr
+ if (nt_alvl <= 0) nt_alvl = ntrcr
+ if (nt_vlvl <= 0) nt_vlvl = ntrcr
+ if (nt_apnd <= 0) nt_apnd = ntrcr
+ if (nt_hpnd <= 0) nt_hpnd = ntrcr
+ if (nt_ipnd <= 0) nt_ipnd = ntrcr
+ if (nt_smice <= 0) nt_smice = ntrcr
+ if (nt_smliq <= 0) nt_smliq = ntrcr
+ if (nt_rhos <= 0) nt_rhos = ntrcr
+ if (nt_rsnw <= 0) nt_rsnw = ntrcr
+ if (nt_fsd <= 0) nt_fsd = ntrcr
+ if (nt_isosno<= 0) nt_isosno= ntrcr
+ if (nt_isoice<= 0) nt_isoice= ntrcr
+ if (nt_aero <= 0) nt_aero = ntrcr
+ if (nt_fbri <= 0) nt_fbri = ntrcr
+ if (nt_bgc_S <= 0) nt_bgc_S = ntrcr
+
+ if (my_task == master_task) then
+ write(nu_diag,*) ' '
+ write(nu_diag,1020) ' ntrcr = ', ntrcr
+ write(nu_diag,1020) ' nbtrcr = ', nbtrcr
+ write(nu_diag,1020) ' nbtrcr_sw = ', nbtrcr_sw
+ write(nu_diag,*) ' '
+ write(nu_diag,1020) ' nt_sice = ', nt_sice
+ write(nu_diag,1020) ' nt_qice = ', nt_qice
+ write(nu_diag,1020) ' nt_qsno = ', nt_qsno
+ write(nu_diag,*)' '
+ 1020 format (a30,2x,i6) ! integer
+ call flush_fileunit(nu_diag)
+ endif ! my_task = master_task
+ call icepack_init_tracer_sizes(ntrcr_in=ntrcr, &
+ ntrcr_o_in=ntrcr_o, nbtrcr_in=nbtrcr, nbtrcr_sw_in=nbtrcr_sw)
+ call icepack_init_tracer_indices(nt_Tsfc_in=nt_Tsfc, nt_sice_in=nt_sice, &
+ nt_qice_in=nt_qice, nt_qsno_in=nt_qsno, nt_iage_in=nt_iage, nt_fy_in=nt_fy, &
+ nt_alvl_in=nt_alvl, nt_vlvl_in=nt_vlvl, nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, &
+ nt_ipnd_in=nt_ipnd, nt_fsd_in=nt_fsd, nt_aero_in=nt_aero, &
+ nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, &
+ nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, &
+ nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, &
+ nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, &
+ nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, &
+ nt_bgc_DOC_in=nt_bgc_DOC, nt_bgc_DON_in=nt_bgc_DON, nt_bgc_DIC_in=nt_bgc_DIC, &
+ nt_zaero_in=nt_zaero, nt_bgc_DMSPp_in=nt_bgc_DMSPp, nt_bgc_DMSPd_in=nt_bgc_DMSPd, &
+ nt_bgc_Fed_in=nt_bgc_Fed, nt_bgc_Fep_in=nt_bgc_Fep, nt_zbgc_frac_in=nt_zbgc_frac, &
+ nlt_zaero_sw_in=nlt_zaero_sw, nlt_chl_sw_in=nlt_chl_sw, nlt_bgc_Sil_in=nlt_bgc_Sil, &
+ nlt_bgc_N_in=nlt_bgc_N, nlt_bgc_Nit_in=nlt_bgc_Nit, nlt_bgc_Am_in=nlt_bgc_Am, &
+ nlt_bgc_DMS_in=nlt_bgc_DMS, nlt_bgc_DMSPp_in=nlt_bgc_DMSPp, nlt_bgc_DMSPd_in=nlt_bgc_DMSPd, &
+ nlt_zaero_in=nlt_zaero, nlt_bgc_chl_in=nlt_bgc_chl, &
+ nlt_bgc_DIC_in=nlt_bgc_DIC, nlt_bgc_DOC_in=nlt_bgc_DOC, nlt_bgc_PON_in=nlt_bgc_PON, &
+ nlt_bgc_DON_in=nlt_bgc_DON, nlt_bgc_Fed_in=nlt_bgc_Fed, nlt_bgc_Fep_in=nlt_bgc_Fep, &
+ nt_bgc_hum_in=nt_bgc_hum, nlt_bgc_hum_in=nlt_bgc_hum)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort2', &
+ file=__FILE__, line=__LINE__)
+
+ if (my_task == master_task) then
+ call icepack_write_tracer_flags(nu_diag)
+ call icepack_write_tracer_sizes(nu_diag)
+ call icepack_write_tracer_indices(nu_diag)
+ endif
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname//' Icepack Abort3', &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine count_tracers
+
+!=======================================================================
+
+! Initialize vertical biogeochemistry
+!
+! author Elizabeth C. Hunke, LANL
+! Nicole Jeffery, LANL
+
+ subroutine init_zbgc
+
+ use ice_state, only: trcr_base, trcr_depend, n_trcr_strata, &
+ nt_strata
+ use ice_arrays_column, only: R_C2N, R_chl2N, R_C2N_DON, R_Si2N, trcrn_sw
+
+ integer (kind=int_kind) :: &
+ nbtrcr, nbtrcr_sw, nt_fbri, &
+ nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, &
+ nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, &
+ nt_bgc_DMSPp, nt_bgc_DMSPd, &
+ nt_zbgc_frac, nlt_chl_sw, &
+ nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, &
+ nlt_bgc_DMS, nlt_bgc_DMSPp, nlt_bgc_DMSPd, &
+ nlt_bgc_PON, nt_bgc_hum, nlt_bgc_hum
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero_sw ! points to aerosol in trcrn_sw
+
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nlt_bgc_N , & ! algae
+ nlt_bgc_chl
+
+ integer (kind=int_kind), dimension(icepack_max_doc) :: &
+ nlt_bgc_DOC ! disolved organic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_don) :: &
+ nlt_bgc_DON !
+
+ integer (kind=int_kind), dimension(icepack_max_dic) :: &
+ nlt_bgc_DIC ! disolved inorganic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_fe) :: &
+ nlt_bgc_Fed , & !
+ nlt_bgc_Fep !
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero ! non-reacting layer aerosols
+
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nt_bgc_N , & ! diatoms, phaeocystis, pico/small
+ nt_bgc_chl ! diatoms, phaeocystis, pico/small
+
+ integer (kind=int_kind), dimension(icepack_max_doc) :: &
+ nt_bgc_DOC ! dissolved organic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_don) :: &
+ nt_bgc_DON ! dissolved organic nitrogen
+
+ integer (kind=int_kind), dimension(icepack_max_dic) :: &
+ nt_bgc_DIC ! dissolved inorganic carbon
+
+ integer (kind=int_kind), dimension(icepack_max_fe) :: &
+ nt_bgc_Fed, & ! dissolved iron
+ nt_bgc_Fep ! particulate iron
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nt_zaero ! black carbon and other aerosols
+
+ integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: &
+ bio_index_o ! relates nlt_bgc_NO to ocean concentration index
+
+ integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: &
+ bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N
+
+ logical (kind=log_kind) :: &
+ tr_brine, &
+ tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, &
+ tr_bgc_DMS, tr_bgc_PON, &
+ tr_bgc_N, tr_bgc_C, tr_bgc_chl, &
+ tr_bgc_DON, tr_bgc_Fe, tr_zaero, &
+ tr_bgc_hum
+
+ real (kind=dbl_kind) :: &
+ initbio_frac, &
+ frazil_scav
+
+ real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: &
+ zbgc_frac_init,&! initializes mobile fraction
+ bgc_tracer_type ! described tracer in mobile or stationary phases
+ ! < 0 is purely mobile (eg. nitrate)
+ ! > 0 has timescales for transitions between
+ ! phases based on whether the ice is melting or growing
+
+ real (kind=dbl_kind), dimension(icepack_max_nbtrcr) :: &
+ zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice
+ tau_ret, & ! retention timescale (s), mobile to stationary phase
+ tau_rel ! release timescale (s), stationary to mobile phase
+
+ logical (kind=log_kind) :: &
+ skl_bgc, z_tracers, dEdd_algae, solve_zsal
+
+ real (kind=dbl_kind), dimension(icepack_max_algae) :: &
+ F_abs_chl ! to scale absorption in Dedd
+
+ real (kind=dbl_kind), dimension(icepack_max_algae) :: &
+ R_S2N , & ! algal S to N (mole/mole)
+ ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia
+ R_Fe2C , & ! algal Fe to carbon (umol/mmol)
+ R_Fe2N ! algal Fe to N (umol/mmol)
+
+ real (kind=dbl_kind), dimension(icepack_max_don) :: &
+ R_Fe2DON ! Fe to N of DON (nmol/umol)
+
+ real (kind=dbl_kind), dimension(icepack_max_doc) :: &
+ R_Fe2DOC ! Fe to C of DOC (nmol/umol)
+
+ real (kind=dbl_kind), dimension(icepack_max_algae) :: &
+ chlabs , & ! chla absorption 1/m/(mg/m^3)
+ alpha2max_low , & ! light limitation (1/(W/m^2))
+ beta2max , & ! light inhibition (1/(W/m^2))
+ mu_max , & ! maximum growth rate (1/d)
+ grow_Tdep , & ! T dependence of growth (1/C)
+ fr_graze , & ! fraction of algae grazed
+ mort_pre , & ! mortality (1/day)
+ mort_Tdep , & ! T dependence of mortality (1/C)
+ k_exude , & ! algal carbon exudation rate (1/d)
+ K_Nit , & ! nitrate half saturation (mmol/m^3)
+ K_Am , & ! ammonium half saturation (mmol/m^3)
+ K_Sil , & ! silicon half saturation (mmol/m^3)
+ K_Fe ! iron half saturation or micromol/m^3
+
+ real (kind=dbl_kind), dimension(icepack_max_DON) :: &
+ f_don , & ! fraction of spilled grazing to DON
+ kn_bac , & ! Bacterial degredation of DON (1/d)
+ f_don_Am ! fraction of remineralized DON to Am
+
+ real (kind=dbl_kind), dimension(icepack_max_DOC) :: &
+ f_doc , & ! fraction of mort_N that goes to each doc pool
+ f_exude , & ! fraction of exuded carbon to each DOC pool
+ k_bac ! Bacterial degredation of DOC (1/d)
+
+ integer (kind=int_kind) :: &
+ k, mm , & ! loop index
+ nk , & ! layer index
+ ierr
+
+ integer (kind=int_kind) :: &
+ ntd , & ! for tracer dependency calculation
+ nt_depend
+
+ character(len=*), parameter :: subname='(init_zbgc)'
+
+ !------------------------------------------------------------
+ ! Tracers have mobile and stationary phases.
+ ! ice growth allows for retention, ice melt facilitates mobility
+ ! bgc_tracer_type defines the exchange timescales between these phases
+ ! -1 : entirely in the mobile phase, no exchange (this is the default)
+ ! 0 : retention time scale is tau_min, release time scale is tau_max
+ ! 1 : retention time scale is tau_max, release time scale is tau_min
+ ! 0.5: retention time scale is tau_min, release time scale is tau_min
+ ! 2 : retention time scale is tau_max, release time scale is tau_max
+ ! tau_min and tau_max are defined in icepack_intfc.f90
+ !------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ ! get values from icepack
+ !-----------------------------------------------------------------
+
+ call icepack_query_parameters( &
+ solve_zsal_out=solve_zsal, &
+ skl_bgc_out=skl_bgc, z_tracers_out=z_tracers, &
+ dEdd_algae_out=dEdd_algae, &
+ grid_o_out=grid_o, l_sk_out=l_sk, &
+ initbio_frac_out=initbio_frac, &
+ grid_oS_out=grid_oS, l_skS_out=l_skS, &
+ phi_snow_out=phi_snow, frazil_scav_out = frazil_scav)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_query_tracer_sizes( &
+ nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_query_tracer_flags( &
+ tr_brine_out =tr_brine, &
+ tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out=tr_bgc_Am, tr_bgc_Sil_out=tr_bgc_Sil, &
+ tr_bgc_DMS_out=tr_bgc_DMS, tr_bgc_PON_out=tr_bgc_PON, &
+ tr_bgc_N_out =tr_bgc_N, tr_bgc_C_out =tr_bgc_C, tr_bgc_chl_out=tr_bgc_chl, &
+ tr_bgc_DON_out=tr_bgc_DON, tr_bgc_Fe_out=tr_bgc_Fe, tr_zaero_out =tr_zaero, &
+ tr_bgc_hum_out=tr_bgc_hum)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call icepack_query_tracer_indices( &
+ nt_fbri_out=nt_fbri, &
+ nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_Am_out=nt_bgc_Am, nt_bgc_Sil_out=nt_bgc_Sil, &
+ nt_bgc_DMS_out=nt_bgc_DMS, nt_bgc_PON_out=nt_bgc_PON, nt_bgc_S_out=nt_bgc_S, &
+ nt_bgc_N_out=nt_bgc_N, nt_bgc_chl_out=nt_bgc_chl, &
+ nt_bgc_DOC_out=nt_bgc_DOC, nt_bgc_DON_out=nt_bgc_DON, nt_bgc_DIC_out=nt_bgc_DIC, &
+ nt_zaero_out=nt_zaero, nt_bgc_DMSPp_out=nt_bgc_DMSPp, nt_bgc_DMSPd_out=nt_bgc_DMSPd, &
+ nt_bgc_Fed_out=nt_bgc_Fed, nt_bgc_Fep_out=nt_bgc_Fep, nt_zbgc_frac_out=nt_zbgc_frac, &
+ nlt_zaero_sw_out=nlt_zaero_sw, nlt_chl_sw_out=nlt_chl_sw, nlt_bgc_Sil_out=nlt_bgc_Sil, &
+ nlt_bgc_N_out=nlt_bgc_N, nlt_bgc_Nit_out=nlt_bgc_Nit, nlt_bgc_Am_out=nlt_bgc_Am, &
+ nlt_bgc_DMS_out=nlt_bgc_DMS, nlt_bgc_DMSPp_out=nlt_bgc_DMSPp, nlt_bgc_DMSPd_out=nlt_bgc_DMSPd, &
+ nlt_zaero_out=nlt_zaero, nlt_bgc_chl_out=nlt_bgc_chl, &
+ nlt_bgc_DIC_out=nlt_bgc_DIC, nlt_bgc_DOC_out=nlt_bgc_DOC, nlt_bgc_PON_out=nlt_bgc_PON, &
+ nlt_bgc_DON_out=nlt_bgc_DON, nlt_bgc_Fed_out=nlt_bgc_Fed, nlt_bgc_Fep_out=nlt_bgc_Fep, &
+ nt_bgc_hum_out=nt_bgc_hum, nlt_bgc_hum_out=nlt_bgc_hum)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Define array parameters
+ !-----------------------------------------------------------------
+
+ allocate( &
+ R_C2N_DON(icepack_max_don), & ! carbon to nitrogen mole ratio of DON pool
+ R_C2N(icepack_max_algae), & ! algal C to N (mole/mole)
+ R_chl2N(icepack_max_algae), & ! 3 algal chlorophyll to N (mg/mmol)
+ R_Si2N(icepack_max_algae), & ! silica to nitrogen mole ratio for algal groups
+ stat=ierr)
+ if (ierr/=0) call abort_ice(subname//' Out of Memory')
+
+ R_Si2N(1) = ratio_Si2N_diatoms
+ R_Si2N(2) = ratio_Si2N_sp
+ R_Si2N(3) = ratio_Si2N_phaeo
+
+ R_S2N(1) = ratio_S2N_diatoms
+ R_S2N(2) = ratio_S2N_sp
+ R_S2N(3) = ratio_S2N_phaeo
+
+ R_Fe2C(1) = ratio_Fe2C_diatoms
+ R_Fe2C(2) = ratio_Fe2C_sp
+ R_Fe2C(3) = ratio_Fe2C_phaeo
+
+ R_Fe2N(1) = ratio_Fe2N_diatoms
+ R_Fe2N(2) = ratio_Fe2N_sp
+ R_Fe2N(3) = ratio_Fe2N_phaeo
+
+ R_C2N(1) = ratio_C2N_diatoms
+ R_C2N(2) = ratio_C2N_sp
+ R_C2N(3) = ratio_C2N_phaeo
+
+ R_chl2N(1) = ratio_chl2N_diatoms
+ R_chl2N(2) = ratio_chl2N_sp
+ R_chl2N(3) = ratio_chl2N_phaeo
+
+ F_abs_chl(1) = F_abs_chl_diatoms
+ F_abs_chl(2) = F_abs_chl_sp
+ F_abs_chl(3) = F_abs_chl_phaeo
+
+ R_Fe2DON(1) = ratio_Fe2DON
+ R_C2N_DON(1) = ratio_C2N_proteins
+
+ R_Fe2DOC(1) = ratio_Fe2DOC_s
+ R_Fe2DOC(2) = ratio_Fe2DOC_l
+ R_Fe2DOC(3) = c0
+
+ chlabs(1) = chlabs_diatoms
+ chlabs(2) = chlabs_sp
+ chlabs(3) = chlabs_phaeo
+
+ alpha2max_low(1) = alpha2max_low_diatoms
+ alpha2max_low(2) = alpha2max_low_sp
+ alpha2max_low(3) = alpha2max_low_phaeo
+
+ beta2max(1) = beta2max_diatoms
+ beta2max(2) = beta2max_sp
+ beta2max(3) = beta2max_phaeo
+
+ mu_max(1) = mu_max_diatoms
+ mu_max(2) = mu_max_sp
+ mu_max(3) = mu_max_phaeo
+
+ grow_Tdep(1) = grow_Tdep_diatoms
+ grow_Tdep(2) = grow_Tdep_sp
+ grow_Tdep(3) = grow_Tdep_phaeo
+
+ fr_graze(1) = fr_graze_diatoms
+ fr_graze(2) = fr_graze_sp
+ fr_graze(3) = fr_graze_phaeo
+
+ mort_pre(1) = mort_pre_diatoms
+ mort_pre(2) = mort_pre_sp
+ mort_pre(3) = mort_pre_phaeo
+
+ mort_Tdep(1) = mort_Tdep_diatoms
+ mort_Tdep(2) = mort_Tdep_sp
+ mort_Tdep(3) = mort_Tdep_phaeo
+
+ k_exude(1) = k_exude_diatoms
+ k_exude(2) = k_exude_sp
+ k_exude(3) = k_exude_phaeo
+
+ K_Nit(1) = K_Nit_diatoms
+ K_Nit(2) = K_Nit_sp
+ K_Nit(3) = K_Nit_phaeo
+
+ K_Am(1) = K_Am_diatoms
+ K_Am(2) = K_Am_sp
+ K_Am(3) = K_Am_phaeo
+
+ K_Sil(1) = K_Sil_diatoms
+ K_Sil(2) = K_Sil_sp
+ K_Sil(3) = K_Sil_phaeo
+
+ K_Fe(1) = K_Fe_diatoms
+ K_Fe(2) = K_Fe_sp
+ K_Fe(3) = K_Fe_phaeo
+
+ f_don(1) = f_don_protein
+ kn_bac(1) = kn_bac_protein
+ f_don_Am(1) = f_don_Am_protein
+
+ f_doc(1) = f_doc_s
+ f_doc(2) = f_doc_l
+
+ f_exude(1) = f_exude_s
+ f_exude(2) = f_exude_l
+ k_bac(1) = k_bac_s
+ k_bac(2) = k_bac_l
+
+ dictype(:) = -c1
+
+ algaltype(1) = algaltype_diatoms
+ algaltype(2) = algaltype_sp
+ algaltype(3) = algaltype_phaeo
+
+ doctype(1) = doctype_s
+ doctype(2) = doctype_l
+
+ dontype(1) = dontype_protein
+
+ fedtype(1) = fedtype_1
+ feptype(1) = feptype_1
+
+ zaerotype(1) = zaerotype_bc1
+ zaerotype(2) = zaerotype_bc2
+ zaerotype(3) = zaerotype_dust1
+ zaerotype(4) = zaerotype_dust2
+ zaerotype(5) = zaerotype_dust3
+ zaerotype(6) = zaerotype_dust4
+
+ call icepack_init_zbgc ( &
+!opt R_S2N_in=R_S2N, R_Fe2C_in=R_Fe2C, R_Fe2N_in=R_Fe2N, R_C2N_in=R_C2N, &
+!opt R_chl2N_in=R_chl2N, F_abs_chl_in=F_abs_chl, R_Fe2DON_in=R_Fe2DON, R_Fe2DOC_in=R_Fe2DOC, &
+!opt mort_Tdep_in=mort_Tdep, k_exude_in=k_exude, &
+!opt K_Nit_in=K_Nit, K_Am_in=K_Am, K_sil_in=K_Sil, K_Fe_in=K_Fe, &
+!opt f_don_in=f_don, kn_bac_in=kn_bac, f_don_Am_in=f_don_Am, f_exude_in=f_exude, k_bac_in=k_bac, &
+!opt fr_resp_in=fr_resp, algal_vel_in=algal_vel, R_dFe2dust_in=R_dFe2dust, &
+!opt dustFe_sol_in=dustFe_sol, T_max_in=T_max, fr_mort2min_in=fr_mort2min, fr_dFe_in=fr_dFe, &
+!opt op_dep_min_in=op_dep_min, fr_graze_s_in=fr_graze_s, fr_graze_e_in=fr_graze_e, &
+!opt k_nitrif_in=k_nitrif, t_iron_conv_in=t_iron_conv, max_loss_in=max_loss, max_dfe_doc1_in=max_dfe_doc1, &
+!opt fr_resp_s_in=fr_resp_s, y_sk_DMS_in=y_sk_DMS, t_sk_conv_in=t_sk_conv, t_sk_ox_in=t_sk_ox, &
+!opt mu_max_in=mu_max, R_Si2N_in=R_Si2N, R_C2N_DON_in=R_C2N_DON, chlabs_in=chlabs, &
+!opt alpha2max_low_in=alpha2max_low, beta2max_in=beta2max, grow_Tdep_in=grow_Tdep, &
+!opt fr_graze_in=fr_graze, mort_pre_in=mort_pre, f_doc_in=f_doc,fsal_in=fsal, &
+ )
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! assign tracer dependencies
+ ! bgc_tracer_type: < 0 purely mobile , >= 0 stationary
+ !------------------------------------------------------------------
+
+ if (tr_brine) then
+ trcr_depend(nt_fbri) = 1 ! volume-weighted
+ trcr_base (nt_fbri,1) = c0 ! volume-weighted
+ trcr_base (nt_fbri,2) = c1 ! volume-weighted
+ trcr_base (nt_fbri,3) = c0 ! volume-weighted
+ n_trcr_strata(nt_fbri) = 0
+ nt_strata (nt_fbri,1) = 0
+ nt_strata (nt_fbri,2) = 0
+ endif
+
+ ntd = 0 ! if nt_fbri /= 0 then use fbri dependency
+ if (nt_fbri == 0) ntd = -1 ! otherwise make tracers depend on ice volume
+
+ if (solve_zsal) then ! .true. only if tr_brine = .true.
+ do k = 1,nblyr
+ trcr_depend(nt_bgc_S + k - 1) = 2 + nt_fbri + ntd
+ trcr_base (nt_bgc_S,1) = c0 ! default: ice area
+ trcr_base (nt_bgc_S,2) = c1
+ trcr_base (nt_bgc_S,3) = c0
+ n_trcr_strata(nt_bgc_S) = 1
+ nt_strata(nt_bgc_S,1) = nt_fbri
+ nt_strata(nt_bgc_S,2) = 0
+ enddo
+ endif
+
+ bio_index(:) = 0
+ bio_index_o(:) = 0
+
+ if (skl_bgc) then
+ nk = 1
+ nt_depend = 0
+ elseif (z_tracers) then ! defined on nblyr+1 in ice
+ ! and 2 snow layers (snow surface + interior)
+ nk = nblyr + 1
+ nt_depend = 2 + nt_fbri + ntd
+ endif ! skl_bgc or z_tracers
+
+ if (skl_bgc .or. z_tracers) then
+
+ if (tr_bgc_N) then
+ do mm = 1, n_algae
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_N(mm), nlt_bgc_N(mm), &
+ algaltype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_N(mm)) = mm
+ enddo ! mm
+ endif ! tr_bgc_N
+
+ if (tr_bgc_Nit) then
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_Nit, nlt_bgc_Nit, &
+ nitratetype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_Nit) = icepack_max_algae + 1
+ endif ! tr_bgc_Nit
+
+ if (tr_bgc_C) then
+ !
+ ! Algal C is not yet distinct from algal N
+ ! * Reqires exudation and/or changing C:N ratios
+ ! for implementation
+ !
+ ! do mm = 1,n_algae
+ ! call init_bgc_trcr(nk, nt_fbri, &
+ ! nt_bgc_C(mm), nlt_bgc_C(mm), &
+ ! algaltype(mm), nt_depend, &
+ ! bgc_tracer_type, trcr_depend, &
+ ! trcr_base, n_trcr_strata, &
+ ! nt_strata, bio_index)
+ ! bio_index_o(nlt_bgc_C(mm)) = icepack_max_algae + 1 + mm
+ ! enddo ! mm
+
+ do mm = 1, n_doc
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DOC(mm), nlt_bgc_DOC(mm), &
+ doctype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DOC(mm)) = icepack_max_algae + 1 + mm
+ enddo ! mm
+ do mm = 1, n_dic
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DIC(mm), nlt_bgc_DIC(mm), &
+ dictype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DIC(mm)) = icepack_max_algae + icepack_max_doc + 1 + mm
+ enddo ! mm
+ endif ! tr_bgc_C
+
+ if (tr_bgc_chl) then
+ do mm = 1, n_algae
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_chl(mm), nlt_bgc_chl(mm), &
+ algaltype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_chl(mm)) = icepack_max_algae + 1 + icepack_max_doc + icepack_max_dic + mm
+ enddo ! mm
+ endif ! tr_bgc_chl
+
+ if (tr_bgc_Am) then
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_Am, nlt_bgc_Am, &
+ ammoniumtype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_Am) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 2
+ endif
+ if (tr_bgc_Sil) then
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_Sil, nlt_bgc_Sil, &
+ silicatetype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_Sil) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 3
+ endif
+ if (tr_bgc_DMS) then ! all together
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DMSPp, nlt_bgc_DMSPp, &
+ dmspptype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DMSPp) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 4
+
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DMSPd, nlt_bgc_DMSPd, &
+ dmspdtype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DMSPd) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 5
+
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DMS, nlt_bgc_DMS, &
+ dmspdtype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DMS) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 6
+ endif
+ if (tr_bgc_PON) then
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_PON, nlt_bgc_PON, &
+ nitratetype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_PON) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7
+ endif
+ if (tr_bgc_DON) then
+ do mm = 1, n_don
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_DON(mm), nlt_bgc_DON(mm), &
+ dontype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_DON(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic + 7 + mm
+ enddo ! mm
+ endif ! tr_bgc_DON
+ if (tr_bgc_Fe) then
+ do mm = 1, n_fed
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_Fed(mm), nlt_bgc_Fed(mm), &
+ fedtype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_Fed(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic &
+ + icepack_max_don + 7 + mm
+ enddo ! mm
+ do mm = 1, n_fep
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_Fep(mm), nlt_bgc_Fep(mm), &
+ feptype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_Fep(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic &
+ + icepack_max_don + icepack_max_fe + 7 + mm
+ enddo ! mm
+ endif ! tr_bgc_Fe
+
+ if (tr_bgc_hum) then
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc_hum, nlt_bgc_hum, &
+ humtype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_bgc_hum) = 2*icepack_max_algae + icepack_max_doc + 8 + icepack_max_dic &
+ + icepack_max_don + 2*icepack_max_fe + icepack_max_aero
+ endif
+ endif ! skl_bgc or z_tracers
+
+ if (skl_bgc) then
+ if (dEdd_algae) then
+ nlt_chl_sw = 1
+ nbtrcr_sw = nilyr+nslyr+2 ! only the bottom layer will be nonzero
+ endif
+
+ elseif (z_tracers) then ! defined on nblyr+1 in ice
+ ! and 2 snow layers (snow surface + interior)
+ if (tr_bgc_N) then
+ if (dEdd_algae) then
+ nlt_chl_sw = 1
+ nbtrcr_sw = nilyr+nslyr+2
+ endif
+ endif ! tr_bgc_N
+ endif ! skl_bgc or z_tracers
+
+ if (z_tracers) then ! defined on nblyr+1 in ice
+ ! and 2 snow layers (snow surface + interior)
+
+ nk = nblyr + 1
+ nt_depend = 2 + nt_fbri + ntd
+
+ ! z layer aerosols
+ if (tr_zaero) then
+ do mm = 1, n_zaero
+ if (dEdd_algae) then
+ nlt_zaero_sw(mm) = nbtrcr_sw + 1
+ nbtrcr_sw = nbtrcr_sw + nilyr + nslyr+2
+ endif
+ call init_bgc_trcr(nk, nt_fbri, &
+ nt_zaero(mm), nlt_zaero(mm), &
+ zaerotype(mm), nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+ bio_index_o(nlt_zaero(mm)) = 2*icepack_max_algae + icepack_max_doc + icepack_max_dic &
+ + icepack_max_don + 2*icepack_max_fe + 7 + mm
+ enddo ! mm
+ endif ! tr_zaero
+
+ if (nbtrcr > 0) then
+ do k = 1,nbtrcr
+ zbgc_frac_init(k) = c1
+ trcr_depend(nt_zbgc_frac+k-1) = 2+nt_fbri
+ trcr_base(nt_zbgc_frac+ k - 1,1) = c0
+ trcr_base(nt_zbgc_frac+ k - 1,2) = c1
+ trcr_base(nt_zbgc_frac+ k - 1,3) = c0
+ n_trcr_strata(nt_zbgc_frac+ k - 1)= 1
+ nt_strata(nt_zbgc_frac+ k - 1,1) = nt_fbri
+ nt_strata(nt_zbgc_frac+ k - 1,2) = 0
+ tau_ret(k) = c1
+ tau_rel(k) = c1
+ if (bgc_tracer_type(k) >= c0 .and. bgc_tracer_type(k) < p5) then
+ tau_ret(k) = tau_min
+ tau_rel(k) = tau_max
+ zbgc_frac_init(k) = c1
+ elseif (bgc_tracer_type(k) >= p5 .and. bgc_tracer_type(k) < c1) then
+ tau_ret(k) = tau_min
+ tau_rel(k) = tau_min
+ zbgc_frac_init(k) = c1
+ elseif (bgc_tracer_type(k) >= c1 .and. bgc_tracer_type(k) < c2) then
+ tau_ret(k) = tau_max
+ tau_rel(k) = tau_min
+ zbgc_frac_init(k) = c1
+ elseif (bgc_tracer_type(k) >= c2 ) then
+ tau_ret(k) = tau_max
+ tau_rel(k) = tau_max
+ zbgc_frac_init(k) = c1
+ endif
+ enddo
+ endif
+
+ endif ! z_tracers
+
+ do k = 1, nbtrcr
+ zbgc_init_frac(k) = frazil_scav
+ if (bgc_tracer_type(k) < c0) zbgc_init_frac(k) = initbio_frac
+ enddo
+
+ !-----------------------------------------------------------------
+ ! set values in icepack
+ !-----------------------------------------------------------------
+
+ call icepack_init_zbgc( &
+!opt zbgc_init_frac_in=zbgc_init_frac, tau_ret_in=tau_ret, tau_rel_in=tau_rel, &
+!opt zbgc_frac_init_in=zbgc_frac_init, bgc_tracer_type_in=bgc_tracer_type, &
+ )
+ call icepack_init_tracer_indices( &
+ bio_index_o_in=bio_index_o, bio_index_in=bio_index)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! final consistency checks
+ !-----------------------------------------------------------------
+ if (nbtrcr > icepack_max_nbtrcr) then
+ write (nu_diag,*) subname,' '
+ write (nu_diag,*) subname,'nbtrcr > icepack_max_nbtrcr'
+ write (nu_diag,*) subname,'nbtrcr, icepack_max_nbtrcr:',nbtrcr, icepack_max_nbtrcr
+ call abort_ice (subname//'ERROR: nbtrcr > icepack_max_nbtrcr')
+ endif
+ if (.NOT. dEdd_algae) nbtrcr_sw = 1
+
+ ! tcraig, added 6/1/21, why is nbtrcr_sw set here?
+ call icepack_init_tracer_sizes(nbtrcr_sw_in=nbtrcr_sw)
+ allocate(trcrn_sw(nx_block,ny_block,nbtrcr_sw,ncat,max_blocks)) ! bgc tracers active in the delta-Eddington shortwave
+
+ !-----------------------------------------------------------------
+ ! spew
+ !-----------------------------------------------------------------
+ if (my_task == master_task) then
+ if (skl_bgc) then
+
+ write(nu_diag,1020) ' number of bio tracers = ', nbtrcr
+ write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw
+
+ elseif (z_tracers) then
+
+ write(nu_diag,1020) ' number of ztracers = ', nbtrcr
+ write(nu_diag,1020) ' number of Isw tracers = ', nbtrcr_sw
+ write(nu_diag,1000) ' initbio_frac = ', initbio_frac
+ write(nu_diag,1000) ' frazil_scav = ', frazil_scav
+
+ endif ! skl_bgc or solve_bgc
+ endif ! master_task
+
+ 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements
+ 1020 format (a30,2x,i6) ! integer
+
+ end subroutine init_zbgc
+
+!=======================================================================
+
+ subroutine init_bgc_trcr(nk, nt_fbri, &
+ nt_bgc, nlt_bgc, &
+ bgctype, nt_depend, &
+ bgc_tracer_type, trcr_depend, &
+ trcr_base, n_trcr_strata, &
+ nt_strata, bio_index)
+
+ integer (kind=int_kind), intent(in) :: &
+ nk , & ! counter
+ nt_depend , & ! tracer dependency index
+ nt_bgc , & ! tracer index
+ nlt_bgc , & ! bio tracer index
+ nt_fbri
+
+ integer (kind=int_kind), dimension(:), intent(inout) :: &
+ trcr_depend , & ! tracer dependencies
+ n_trcr_strata, & ! number of underlying tracer layers
+ bio_index !
+
+ integer (kind=int_kind), dimension(:,:), intent(inout) :: &
+ nt_strata ! indices of underlying tracer layers
+
+ real (kind=dbl_kind), dimension(:,:), intent(inout) :: &
+ trcr_base ! = 0 or 1 depending on tracer dependency
+ ! argument 2: (1) aice, (2) vice, (3) vsno
+
+ real (kind=dbl_kind), intent(in) :: &
+ bgctype ! bio tracer transport type (mobile vs stationary)
+
+ real (kind=dbl_kind), dimension(:), intent(inout) :: &
+ bgc_tracer_type ! bio tracer transport type array
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ k , & ! loop index
+ n_strata , & ! temporary values
+ nt_strata1, & !
+ nt_strata2
+
+ real (kind=dbl_kind) :: &
+ trcr_base1, & ! temporary values
+ trcr_base2, &
+ trcr_base3
+
+ character(len=*), parameter :: subname='(init_bgc_trcr)'
+
+ !--------
+
+ bgc_tracer_type(nlt_bgc) = bgctype
+
+ if (nk > 1) then ! include vertical bgc in snow
+ do k = nk, nk+1
+ trcr_depend (nt_bgc + k ) = 2 ! snow volume
+ trcr_base (nt_bgc + k,1) = c0
+ trcr_base (nt_bgc + k,2) = c0
+ trcr_base (nt_bgc + k,3) = c1
+ n_trcr_strata(nt_bgc + k ) = 0
+ nt_strata (nt_bgc + k,1) = 0
+ nt_strata (nt_bgc + k,2) = 0
+ enddo
+
+ trcr_base1 = c0
+ trcr_base2 = c1
+ trcr_base3 = c0
+ n_strata = 1
+ nt_strata1 = nt_fbri
+ nt_strata2 = 0
+ else ! nk = 1
+ trcr_base1 = c1
+ trcr_base2 = c0
+ trcr_base3 = c0
+ n_strata = 0
+ nt_strata1 = 0
+ nt_strata2 = 0
+ endif ! nk
+
+ do k = 1, nk ! in ice
+ trcr_depend (nt_bgc + k - 1 ) = nt_depend
+ trcr_base (nt_bgc + k - 1,1) = trcr_base1
+ trcr_base (nt_bgc + k - 1,2) = trcr_base2
+ trcr_base (nt_bgc + k - 1,3) = trcr_base3
+ n_trcr_strata(nt_bgc + k - 1 ) = n_strata
+ nt_strata (nt_bgc + k - 1,1) = nt_strata1
+ nt_strata (nt_bgc + k - 1,2) = nt_strata2
+ enddo
+
+ bio_index (nlt_bgc) = nt_bgc
+
+ end subroutine init_bgc_trcr
+
+!=======================================================================
+
+ end module ice_init_column
+
+!=======================================================================
diff --git a/cicecore/drivers/unittest/opticep/ice_step_mod.F90 b/cicecore/drivers/unittest/opticep/ice_step_mod.F90
new file mode 100644
index 000000000..ac66255a4
--- /dev/null
+++ b/cicecore/drivers/unittest/opticep/ice_step_mod.F90
@@ -0,0 +1,1784 @@
+!=======================================================================
+!
+! Contains CICE component driver routines common to all drivers.
+!
+! authors Elizabeth C. Hunke, LANL
+! Philip W. Jones, LANL
+! William H. Lipscomb, LANL
+!
+! 2008 ECH: created module by moving subroutines from drivers/cice4/
+! 2014 ECH: created column package
+
+ module ice_step_mod
+
+ use ice_kinds_mod
+ use ice_blocks, only: block, get_block
+ use ice_blocks, only: nx_block, ny_block
+ use ice_constants, only: c0, c1, c1000, c4, p25
+ use ice_constants, only: field_loc_center, field_loc_NEcorner, &
+ field_loc_Nface, field_loc_Eface, &
+ field_type_scalar, field_type_vector
+ use ice_domain, only: halo_info, nblocks, blocks_ice
+ use ice_domain_size, only: max_blocks
+ use ice_exit, only: abort_ice
+ use ice_fileunits, only: nu_diag
+ use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
+ use icepack_intfc, only: icepack_prep_radiation
+ use icepack_intfc, only: icepack_step_therm1
+ use icepack_intfc, only: icepack_step_therm2
+ use icepack_intfc, only: icepack_aggregate
+ use icepack_intfc, only: icepack_step_ridge
+ use icepack_intfc, only: icepack_step_wavefracture
+ use icepack_intfc, only: icepack_step_radiation
+ use icepack_intfc, only: icepack_ocn_mixed_layer, icepack_atm_boundary
+ use icepack_intfc, only: icepack_biogeochemistry, icepack_load_ocean_bio_array
+ use icepack_intfc, only: icepack_max_algae, icepack_max_nbtrcr, icepack_max_don
+ use icepack_intfc, only: icepack_max_doc, icepack_max_dic, icepack_max_aero
+ use icepack_intfc, only: icepack_max_fe, icepack_max_iso
+ use icepack_intfc, only: icepack_query_parameters
+ use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes
+ use icepack_intfc, only: icepack_query_tracer_indices
+
+ implicit none
+ private
+
+ public :: step_therm1, step_therm2, step_dyn_horiz, step_dyn_ridge, &
+ step_snow, prep_radiation, step_radiation, ocean_mixed_layer, &
+ update_state, biogeochemistry, step_dyn_wave, step_prep
+
+ real (kind=dbl_kind), dimension (:,:,:), allocatable :: &
+ uvelT_icep, & ! uvel for wind stress computation in icepack
+ vvelT_icep ! vvel for wind stress computation in icepack
+
+!=======================================================================
+
+ contains
+
+!=======================================================================
+
+ subroutine save_init
+! saves initial values for aice, aicen, vicen, vsnon
+
+ use ice_state, only: aice, aicen, aice_init, aicen_init, &
+ vicen, vicen_init, vsnon, vsnon_init
+
+ character(len=*), parameter :: subname = '(save_init)'
+
+ !-----------------------------------------------------------------
+ ! Save the ice area passed to the coupler (so that history fields
+ ! can be made consistent with coupler fields).
+ ! Save the initial ice area and volume in each category.
+ !-----------------------------------------------------------------
+
+ aice_init = aice
+ aicen_init = aicen
+ vicen_init = vicen
+ vsnon_init = vsnon
+
+ end subroutine save_init
+
+!=======================================================================
+
+ subroutine step_prep
+! prep for step, called outside nblock loop
+
+ use ice_flux, only: uatm, vatm, uatmT, vatmT
+ use ice_grid, only: grid_atm_dynu, grid_atm_dynv, grid_average_X2Y
+ use ice_state, only: uvel, vvel
+
+ logical (kind=log_kind) :: &
+ highfreq ! highfreq flag
+
+ logical (kind=log_kind), save :: &
+ first_call = .true. ! first call flag
+
+ character(len=*), parameter :: subname = '(step_prep)'
+
+ ! Save initial state
+
+ call save_init
+
+ ! Compute uatmT, vatmT
+
+ call grid_average_X2Y('S',uatm,grid_atm_dynu,uatmT,'T')
+ call grid_average_X2Y('S',vatm,grid_atm_dynv,vatmT,'T')
+
+ !-----------------------------------------------------------------
+ ! Compute uvelT_icep, vvelT_icep
+ !-----------------------------------------------------------------
+
+ if (first_call) then
+ allocate(uvelT_icep(nx_block,ny_block,max_blocks))
+ allocate(vvelT_icep(nx_block,ny_block,max_blocks))
+ uvelT_icep = c0
+ vvelT_icep = c0
+ endif
+
+ call icepack_query_parameters(highfreq_out=highfreq)
+
+ if (highfreq) then
+ call grid_average_X2Y('A', uvel, 'U', uvelT_icep, 'T')
+ call grid_average_X2Y('A', vvel, 'U', vvelT_icep, 'T')
+ endif
+
+ first_call = .false.
+
+ end subroutine step_prep
+
+!=======================================================================
+!
+! Scales radiation fields computed on the previous time step.
+!
+! authors: Elizabeth Hunke, LANL
+
+ subroutine prep_radiation (iblk)
+
+ use ice_domain_size, only: ncat, nilyr, nslyr
+ use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, &
+ alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, &
+ alvdr_init, alvdf_init, alidr_init, alidf_init
+ use ice_arrays_column, only: fswsfcn, fswintn, &
+ fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, &
+ fswpenln, Sswabsn, Iswabsn
+ use ice_state, only: aice, aicen
+ use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j ! horizontal indices
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ character(len=*), parameter :: subname = '(prep_radiation)'
+
+ call ice_timer_start(timer_sw,iblk) ! shortwave
+
+ alvdr_init(:,:,iblk) = c0
+ alvdf_init(:,:,iblk) = c0
+ alidr_init(:,:,iblk) = c0
+ alidf_init(:,:,iblk) = c0
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ !-----------------------------------------------------------------
+ ! Compute netsw scaling factor (new netsw / old netsw)
+ !-----------------------------------------------------------------
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ alvdr_init(i,j,iblk) = alvdr_ai(i,j,iblk)
+ alvdf_init(i,j,iblk) = alvdf_ai(i,j,iblk)
+ alidr_init(i,j,iblk) = alidr_ai(i,j,iblk)
+ alidf_init(i,j,iblk) = alidf_ai(i,j,iblk)
+
+ call icepack_prep_radiation (ncat=ncat, nilyr=nilyr, nslyr=nslyr, &
+ scale_factor=scale_factor(i,j,iblk), &
+ aice = aice (i,j, iblk), aicen = aicen (i,j, :,iblk), &
+ swvdr = swvdr (i,j, iblk), swvdf = swvdf (i,j, iblk), &
+ swidr = swidr (i,j, iblk), swidf = swidf (i,j, iblk), &
+ alvdr_ai = alvdr_ai(i,j, iblk), alvdf_ai = alvdf_ai(i,j, iblk), &
+ alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), &
+ fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), &
+ fswthrun = fswthrun(i,j, :,iblk), &
+!opt fswthrun_vdr = fswthrun_vdr(i,j, :,iblk), &
+!opt fswthrun_vdf = fswthrun_vdf(i,j, :,iblk), &
+!opt fswthrun_idr = fswthrun_idr(i,j, :,iblk), &
+!opt fswthrun_idf = fswthrun_idf(i,j, :,iblk), &
+ fswpenln = fswpenln(i,j,:,:,iblk), &
+ Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk))
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call ice_timer_stop(timer_sw,iblk) ! shortwave
+
+ end subroutine prep_radiation
+
+!=======================================================================
+!
+! Driver for updating ice and snow internal temperatures and
+! computing thermodynamic growth rates and coupler fluxes.
+!
+! authors: William H. Lipscomb, LANL
+
+ subroutine step_therm1 (dt, iblk)
+
+ use ice_arrays_column, only: ffracn, dhsn, &
+ Cdn_ocn, Cdn_ocn_skin, Cdn_ocn_floe, Cdn_ocn_keel, Cdn_atm_ratio, &
+ Cdn_atm, Cdn_atm_skin, Cdn_atm_floe, Cdn_atm_rdg, Cdn_atm_pond, &
+ hfreebd, hdraft, hridge, distrdg, hkeel, dkeel, lfloe, dfloe, &
+ fswsfcn, fswintn, Sswabsn, Iswabsn, meltsliqn, meltsliq, &
+ fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf
+ use ice_calendar, only: yday
+ use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero
+ use ice_flux, only: frzmlt, sst, Tf, strocnxT_iavg, strocnyT_iavg, rside, fbot, Tbot, Tsnice, &
+ meltsn, melttn, meltbn, congeln, snoicen, uatmT, vatmT, fside, wlat, &
+ wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, &
+ flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, fsloss, &
+ frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, &
+ flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, &
+ fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, &
+ meltt, melts, meltb, congel, snoice, &
+ flatn_f, fsensn_f, fsurfn_f, fcondtopn_f, &
+ send_i2x_per_cat, fswthrun_ai, dsnow
+ use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, &
+ Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn
+ use ice_grid, only: lmask_n, lmask_s, tmask
+ use ice_state, only: aice, aicen, aicen_init, vicen_init, &
+ vice, vicen, vsno, vsnon, trcrn, vsnon_init
+#ifdef CICE_IN_NEMO
+ use ice_state, only: aice_init
+#endif
+
+#ifdef CESMCOUPLED
+ use ice_prescribed_mod, only: prescribed_ice
+#else
+ logical (kind=log_kind) :: &
+ prescribed_ice ! if .true., use prescribed ice instead of computed
+#endif
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step (s)
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+#ifdef CICE_IN_NEMO
+ real (kind=dbl_kind) :: &
+ raice ! reciprocal of ice concentration
+#endif
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j , & ! horizontal indices
+ n , & ! thickness category index
+ k, kk ! indices for aerosols
+
+ integer (kind=int_kind) :: &
+ ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, &
+ nt_iage, nt_FY, nt_qice, nt_sice, nt_aero, nt_qsno, &
+ nt_isosno, nt_isoice, nt_rsnw, nt_smice, nt_smliq
+
+ logical (kind=log_kind) :: &
+ tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, &
+ tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow
+
+ real (kind=dbl_kind) :: &
+ puny ! a very small number
+
+ real (kind=dbl_kind), dimension(n_aero,2,ncat) :: &
+ aerosno, aeroice ! kg/m^2
+
+ real (kind=dbl_kind), dimension(n_iso,ncat) :: &
+ isosno, isoice ! kg/m^2
+
+ real (kind=dbl_kind), dimension(nslyr,ncat) :: &
+ rsnwn, smicen, smliqn
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ character(len=*), parameter :: subname = '(step_therm1)'
+
+ call icepack_query_parameters(puny_out=puny)
+ call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc)
+ call icepack_query_parameters(highfreq_out=highfreq)
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
+ call icepack_query_tracer_flags( &
+ tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, &
+ tr_aero_out=tr_aero, tr_pond_out=tr_pond, &
+ tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, &
+ tr_snow_out=tr_snow)
+ call icepack_query_tracer_indices( &
+ nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, &
+ nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_Tsfc_out=nt_Tsfc, &
+ nt_iage_out=nt_iage, nt_FY_out=nt_FY, &
+ nt_qice_out=nt_qice, nt_sice_out=nt_sice, &
+ nt_aero_out=nt_aero, nt_qsno_out=nt_qsno, &
+ nt_rsnw_out=nt_rsnw, nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, &
+ nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+#ifndef CESMCOUPLED
+ prescribed_ice = .false.
+#endif
+
+ rsnwn (:,:) = c0
+ smicen (:,:) = c0
+ smliqn (:,:) = c0
+ isoice (:,:) = c0
+ aerosno(:,:,:) = c0
+ aeroice(:,:,:) = c0
+
+#ifdef CICE_IN_NEMO
+ do j = 1, ny_block
+ do i = 1, nx_block
+
+ !---------------------------------------------------------------
+ ! Scale frain and fsnow by ice concentration as these fields
+ ! are supplied by NEMO multiplied by ice concentration
+ !---------------------------------------------------------------
+
+ if (aice_init(i,j,iblk) > puny) then
+ raice = c1 / aice_init(i,j,iblk)
+ frain(i,j,iblk) = frain(i,j,iblk)*raice
+ fsnow(i,j,iblk) = fsnow(i,j,iblk)*raice
+ else
+ frain(i,j,iblk) = c0
+ fsnow(i,j,iblk) = c0
+ endif
+
+ enddo ! i
+ enddo ! j
+#endif
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ if (tr_snow) then
+ do n = 1, ncat
+ do k = 1, nslyr
+ rsnwn (k,n) = trcrn(i,j,nt_rsnw +k-1,n,iblk)
+ smicen(k,n) = trcrn(i,j,nt_smice+k-1,n,iblk)
+ smliqn(k,n) = trcrn(i,j,nt_smliq+k-1,n,iblk)
+ enddo
+ enddo
+ endif ! tr_snow
+
+ if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3
+ do n=1,ncat
+ do k=1,n_iso
+ isosno(k,n) = trcrn(i,j,nt_isosno+k-1,n,iblk) * vsnon_init(i,j,n,iblk)
+ isoice(k,n) = trcrn(i,j,nt_isoice+k-1,n,iblk) * vicen_init(i,j,n,iblk)
+ enddo
+ enddo
+ endif ! tr_iso
+
+ if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3
+ do n=1,ncat
+ do k=1,n_aero
+ aerosno (k,:,n) = &
+ trcrn(i,j,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n,iblk) &
+ * vsnon_init(i,j,n,iblk)
+ aeroice (k,:,n) = &
+ trcrn(i,j,nt_aero+(k-1)*4+2:nt_aero+(k-1)*4+3,n,iblk) &
+ * vicen_init(i,j,n,iblk)
+ enddo
+ enddo
+ endif ! tr_aero
+
+ if (tmask(i,j,iblk)) then
+
+ call icepack_step_therm1(dt=dt, ncat=ncat, &
+ nilyr=nilyr, nslyr=nslyr, &
+ aicen_init = aicen_init (i,j,:,iblk), &
+ vicen_init = vicen_init (i,j,:,iblk), &
+ vsnon_init = vsnon_init (i,j,:,iblk), &
+ aice = aice (i,j, iblk), &
+ aicen = aicen (i,j,:,iblk), &
+ vice = vice (i,j, iblk), &
+ vicen = vicen (i,j,:,iblk), &
+ vsno = vsno (i,j, iblk), &
+ vsnon = vsnon (i,j,:,iblk), &
+ uvel = uvelT_icep (i,j, iblk), &
+ vvel = vvelT_icep (i,j, iblk), &
+ Tsfc = trcrn (i,j,nt_Tsfc,:,iblk), &
+ zqsn = trcrn (i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), &
+ zqin = trcrn (i,j,nt_qice:nt_qice+nilyr-1,:,iblk), &
+ zSin = trcrn (i,j,nt_sice:nt_sice+nilyr-1,:,iblk), &
+ alvl = trcrn (i,j,nt_alvl,:,iblk), &
+ vlvl = trcrn (i,j,nt_vlvl,:,iblk), &
+ apnd = trcrn (i,j,nt_apnd,:,iblk), &
+ hpnd = trcrn (i,j,nt_hpnd,:,iblk), &
+ ipnd = trcrn (i,j,nt_ipnd,:,iblk), &
+ iage = trcrn (i,j,nt_iage,:,iblk), &
+ FY = trcrn (i,j,nt_FY ,:,iblk), &
+!opt rsnwn = rsnwn (:,:), &
+!opt smicen = smicen (:,:), &
+!opt smliqn = smliqn (:,:), &
+ aerosno = aerosno (:,:,:), &
+ aeroice = aeroice (:,:,:), &
+!opt isosno = isosno (:,:), &
+!opt isoice = isoice (:,:), &
+ uatm = uatmT (i,j, iblk), &
+ vatm = vatmT (i,j, iblk), &
+ wind = wind (i,j, iblk), &
+ zlvl = zlvl (i,j, iblk), &
+!opt zlvs = zlvs (i,j, iblk), &
+ Qa = Qa (i,j, iblk), &
+!opt Qa_iso = Qa_iso (i,j,:,iblk), &
+ rhoa = rhoa (i,j, iblk), &
+ Tair = Tair (i,j, iblk), &
+ Tref = Tref (i,j, iblk), &
+ Qref = Qref (i,j, iblk), &
+!opt Qref_iso = Qref_iso (i,j,:,iblk), &
+ Uref = Uref (i,j, iblk), &
+ Cdn_atm_ratio= Cdn_atm_ratio(i,j, iblk), &
+ Cdn_ocn = Cdn_ocn (i,j, iblk), &
+ Cdn_ocn_skin = Cdn_ocn_skin(i,j, iblk), &
+ Cdn_ocn_floe = Cdn_ocn_floe(i,j, iblk), &
+ Cdn_ocn_keel = Cdn_ocn_keel(i,j, iblk), &
+ Cdn_atm = Cdn_atm (i,j, iblk), &
+ Cdn_atm_skin = Cdn_atm_skin(i,j, iblk), &
+ Cdn_atm_floe = Cdn_atm_floe(i,j, iblk), &
+ Cdn_atm_pond = Cdn_atm_pond(i,j, iblk), &
+ Cdn_atm_rdg = Cdn_atm_rdg (i,j, iblk), &
+ hfreebd = hfreebd (i,j, iblk), &
+ hdraft = hdraft (i,j, iblk), &
+ hridge = hridge (i,j, iblk), &
+ distrdg = distrdg (i,j, iblk), &
+ hkeel = hkeel (i,j, iblk), &
+ dkeel = dkeel (i,j, iblk), &
+ lfloe = lfloe (i,j, iblk), &
+ dfloe = dfloe (i,j, iblk), &
+ strax = strax (i,j, iblk), &
+ stray = stray (i,j, iblk), &
+ strairxT = strairxT (i,j, iblk), &
+ strairyT = strairyT (i,j, iblk), &
+ potT = potT (i,j, iblk), &
+ sst = sst (i,j, iblk), &
+ sss = sss (i,j, iblk), &
+ Tf = Tf (i,j, iblk), &
+ strocnxT = strocnxT_iavg(i,j, iblk), &
+ strocnyT = strocnyT_iavg(i,j, iblk), &
+ fbot = fbot (i,j, iblk), &
+ Tbot = Tbot (i,j, iblk), &
+ Tsnice = Tsnice (i,j, iblk), &
+ frzmlt = frzmlt (i,j, iblk), &
+ rside = rside (i,j, iblk), &
+ fside = fside (i,j, iblk), &
+!opt wlat = wlat (i,j, iblk), &
+ fsnow = fsnow (i,j, iblk), &
+ frain = frain (i,j, iblk), &
+ fpond = fpond (i,j, iblk), &
+!opt fsloss = fsloss (i,j, iblk), &
+ fsurf = fsurf (i,j, iblk), &
+ fsurfn = fsurfn (i,j,:,iblk), &
+ fcondtop = fcondtop (i,j, iblk), &
+ fcondtopn = fcondtopn (i,j,:,iblk), &
+ fcondbot = fcondbot (i,j, iblk), &
+ fcondbotn = fcondbotn (i,j,:,iblk), &
+ fswsfcn = fswsfcn (i,j,:,iblk), &
+ fswintn = fswintn (i,j,:,iblk), &
+ fswthrun = fswthrun (i,j,:,iblk), &
+!opt fswthrun_vdr = fswthrun_vdr (i,j,:,iblk),&
+!opt fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),&
+!opt fswthrun_idr = fswthrun_idr (i,j,:,iblk),&
+!opt fswthrun_idf = fswthrun_idf (i,j,:,iblk),&
+ fswabs = fswabs (i,j, iblk), &
+ flwout = flwout (i,j, iblk), &
+ Sswabsn = Sswabsn (i,j,:,:,iblk), &
+ Iswabsn = Iswabsn (i,j,:,:,iblk), &
+ flw = flw (i,j, iblk), &
+ fsens = fsens (i,j, iblk), &
+ fsensn = fsensn (i,j,:,iblk), &
+ flat = flat (i,j, iblk), &
+ flatn = flatn (i,j,:,iblk), &
+ evap = evap (i,j, iblk), &
+ evaps = evaps (i,j, iblk), &
+ evapi = evapi (i,j, iblk), &
+ fresh = fresh (i,j, iblk), &
+ fsalt = fsalt (i,j, iblk), &
+ fhocn = fhocn (i,j, iblk), &
+ fswthru = fswthru (i,j, iblk), &
+!opt fswthru_vdr = fswthru_vdr (i,j, iblk), &
+!opt fswthru_vdf = fswthru_vdf (i,j, iblk), &
+!opt fswthru_idr = fswthru_idr (i,j, iblk), &
+!opt fswthru_idf = fswthru_idf (i,j, iblk), &
+ flatn_f = flatn_f (i,j,:,iblk), &
+ fsensn_f = fsensn_f (i,j,:,iblk), &
+ fsurfn_f = fsurfn_f (i,j,:,iblk), &
+ fcondtopn_f = fcondtopn_f (i,j,:,iblk), &
+ faero_atm = faero_atm (i,j,1:n_aero,iblk), &
+ faero_ocn = faero_ocn (i,j,1:n_aero,iblk), &
+!opt fiso_atm = fiso_atm (i,j,:,iblk), &
+!opt fiso_ocn = fiso_ocn (i,j,:,iblk), &
+!opt fiso_evap = fiso_evap (i,j,:,iblk), &
+!opt HDO_ocn = HDO_ocn (i,j, iblk), &
+!opt H2_16O_ocn = H2_16O_ocn (i,j, iblk), &
+!opt H2_18O_ocn = H2_18O_ocn (i,j, iblk), &
+ dhsn = dhsn (i,j,:,iblk), &
+ ffracn = ffracn (i,j,:,iblk), &
+ meltt = meltt (i,j, iblk), &
+ melttn = melttn (i,j,:,iblk), &
+ meltb = meltb (i,j, iblk), &
+ meltbn = meltbn (i,j,:,iblk), &
+ melts = melts (i,j, iblk), &
+ meltsn = meltsn (i,j,:,iblk), &
+ congel = congel (i,j, iblk), &
+ congeln = congeln (i,j,:,iblk), &
+ snoice = snoice (i,j, iblk), &
+ snoicen = snoicen (i,j,:,iblk), &
+!opt dsnow = dsnow (i,j, iblk), &
+ dsnown = dsnown (i,j,:,iblk), &
+!opt meltsliq = meltsliq (i,j, iblk), &
+!opt meltsliqn = meltsliqn (i,j,:,iblk), &
+ lmask_n = lmask_n (i,j, iblk), &
+ lmask_s = lmask_s (i,j, iblk), &
+ mlt_onset = mlt_onset (i,j, iblk), &
+ frz_onset = frz_onset (i,j, iblk), &
+ yday=yday &
+!opt prescribed_ice=prescribed_ice, &
+ )
+
+ !-----------------------------------------------------------------
+ ! handle per-category i2x fields, no merging
+ !-----------------------------------------------------------------
+
+ if (send_i2x_per_cat) then
+ do n = 1, ncat
+ ! TODO (mvertens, 2018-12-22): do we need to add the band separated quantities
+ ! for MOM6 here also?
+
+ fswthrun_ai(i,j,n,iblk) = fswthrun(i,j,n,iblk)*aicen_init(i,j,n,iblk)
+ enddo ! ncat
+ endif
+
+ endif
+
+ if (tr_snow) then
+ do n = 1, ncat
+ do k = 1, nslyr
+ trcrn(i,j,nt_rsnw +k-1,n,iblk) = rsnwn (k,n)
+ trcrn(i,j,nt_smice+k-1,n,iblk) = smicen(k,n)
+ trcrn(i,j,nt_smliq+k-1,n,iblk) = smliqn(k,n)
+ enddo
+ enddo
+ endif ! tr_snow
+
+ if (tr_iso) then
+ do n = 1, ncat
+ if (vicen(i,j,n,iblk) > puny) &
+ isoice(:,n) = isoice(:,n)/vicen(i,j,n,iblk)
+ if (vsnon(i,j,n,iblk) > puny) &
+ isosno(:,n) = isosno(:,n)/vsnon(i,j,n,iblk)
+ do k = 1, n_iso
+ trcrn(i,j,nt_isosno+k-1,n,iblk) = isosno(k,n)
+ trcrn(i,j,nt_isoice+k-1,n,iblk) = isoice(k,n)
+ enddo
+ enddo
+ endif ! tr_iso
+
+ if (tr_aero) then
+ do n = 1, ncat
+ if (vicen(i,j,n,iblk) > puny) &
+ aeroice(:,:,n) = aeroice(:,:,n)/vicen(i,j,n,iblk)
+ if (vsnon(i,j,n,iblk) > puny) &
+ aerosno(:,:,n) = aerosno(:,:,n)/vsnon(i,j,n,iblk)
+ do k = 1, n_aero
+ do kk = 1, 2
+ trcrn(i,j,nt_aero+(k-1)*4+kk-1,n,iblk)=aerosno(k,kk,n)
+ trcrn(i,j,nt_aero+(k-1)*4+kk+1,n,iblk)=aeroice(k,kk,n)
+ enddo
+ enddo
+ enddo
+ endif ! tr_aero
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine step_therm1
+
+!=======================================================================
+! Driver for thermodynamic changes not needed for coupling:
+! transport in thickness space, lateral growth and melting.
+!
+! authors: William H. Lipscomb, LANL
+! Elizabeth C. Hunke, LANL
+
+ subroutine step_therm2 (dt, iblk)
+
+ use ice_arrays_column, only: hin_max, fzsal, ocean_bio, wave_sig_ht, &
+ wave_spectrum, wavefreq, dwavefreq, &
+ first_ice, bgrid, cgrid, igrid, floe_rad_c, floe_binwidth, &
+ d_afsd_latg, d_afsd_newi, d_afsd_latm, d_afsd_weld
+ use ice_calendar, only: yday
+ use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd
+ use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, &
+ update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, wlat, &
+ meltl, frazil_diag
+ use ice_flux_bgc, only: flux_bio, faero_ocn, &
+ fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn
+ use ice_grid, only: tmask
+ use ice_state, only: aice, aicen, aice0, trcr_depend, &
+ aicen_init, vicen_init, trcrn, vicen, vsnon, &
+ trcr_base, n_trcr_strata, nt_strata
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j ! horizontal indices
+
+ integer (kind=int_kind) :: &
+ ntrcr, nbtrcr, nltrcr
+
+ logical (kind=log_kind) :: &
+ tr_fsd, & ! floe size distribution tracers
+ z_tracers, & ! vertical biogeochemistry
+ solve_zsal ! zsalinity
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ character(len=*), parameter :: subname = '(step_therm2)'
+
+ call icepack_query_parameters(z_tracers_out=z_tracers,solve_zsal_out=solve_zsal)
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
+ call icepack_query_tracer_flags(tr_fsd_out=tr_fsd)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ ! nltrcr is only used as a zbgc flag in icepack (number of zbgc tracers > 0)
+ if (z_tracers .or. solve_zsal) then
+ nltrcr = 1
+ else
+ nltrcr = 0
+ endif
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ if (tmask(i,j,iblk)) then
+
+ ! significant wave height for FSD
+ if (tr_fsd) &
+ wave_sig_ht(i,j,iblk) = c4*SQRT(SUM(wave_spectrum(i,j,:,iblk)*dwavefreq(:)))
+
+ call icepack_step_therm2(dt=dt, ncat=ncat, &
+ nltrcr=nltrcr, nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, &
+ hin_max = hin_max (:), &
+ aicen = aicen (i,j,:,iblk), &
+ vicen = vicen (i,j,:,iblk), &
+ vsnon = vsnon (i,j,:,iblk), &
+ aicen_init = aicen_init(i,j,:,iblk), &
+ vicen_init = vicen_init(i,j,:,iblk), &
+ trcrn = trcrn (i,j,:,:,iblk), &
+ aice0 = aice0 (i,j, iblk), &
+ aice = aice (i,j, iblk), &
+ trcr_depend= trcr_depend(:), &
+ trcr_base = trcr_base(:,:), &
+ n_trcr_strata = n_trcr_strata(:), &
+ nt_strata = nt_strata(:,:), &
+ Tf = Tf (i,j, iblk), &
+ sss = sss (i,j, iblk), &
+ salinz = salinz (i,j,:,iblk), &
+ rside = rside (i,j, iblk), &
+ meltl = meltl (i,j, iblk), &
+ fside = fside (i,j, iblk), &
+!opt wlat = wlat (i,j, iblk), &
+ frzmlt = frzmlt (i,j, iblk), &
+ frazil = frazil (i,j, iblk), &
+ frain = frain (i,j, iblk), &
+ fpond = fpond (i,j, iblk), &
+ fresh = fresh (i,j, iblk), &
+ fsalt = fsalt (i,j, iblk), &
+ fhocn = fhocn (i,j, iblk), &
+ update_ocn_f = update_ocn_f, &
+ bgrid = bgrid, &
+ cgrid = cgrid, &
+ igrid = igrid, &
+ faero_ocn = faero_ocn (i,j,:,iblk), &
+ first_ice = first_ice (i,j,:,iblk), &
+ fzsal = fzsal (i,j, iblk), &
+ flux_bio = flux_bio (i,j,1:nbtrcr,iblk), &
+ ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), &
+ frazil_diag= frazil_diag(i,j,iblk) &
+!opt frz_onset = frz_onset (i,j, iblk), &
+!opt yday = yday, &
+!opt fiso_ocn = fiso_ocn (i,j,:,iblk), &
+!opt HDO_ocn = HDO_ocn (i,j, iblk), &
+!opt H2_16O_ocn = H2_16O_ocn(i,j, iblk), &
+!opt H2_18O_ocn = H2_18O_ocn(i,j, iblk), &
+!opt nfsd = nfsd, &
+!opt wave_sig_ht= wave_sig_ht(i,j,iblk), &
+!opt wave_spectrum = wave_spectrum(i,j,:,iblk), &
+!opt wavefreq = wavefreq(:), &
+!opt dwavefreq = dwavefreq(:), &
+!opt d_afsd_latg= d_afsd_latg(i,j,:,iblk),&
+!opt d_afsd_newi= d_afsd_newi(i,j,:,iblk),&
+!opt d_afsd_latm= d_afsd_latm(i,j,:,iblk),&
+!opt d_afsd_weld= d_afsd_weld(i,j,:,iblk),&
+!opt floe_rad_c = floe_rad_c(:), &
+!opt floe_binwidth = floe_binwidth(:) &
+ )
+ endif ! tmask
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine step_therm2
+
+!=======================================================================
+!
+! finalize thermo updates
+!
+! authors: Elizabeth Hunke, LANL
+
+ subroutine update_state (dt, daidt, dvidt, dagedt, offset)
+
+ use ice_domain_size, only: ncat
+! use ice_grid, only: tmask
+ use ice_state, only: aicen, trcrn, vicen, vsnon, &
+ aice, trcr, vice, vsno, aice0, trcr_depend, &
+ bound_state, trcr_base, nt_strata, n_trcr_strata
+ use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound, timer_updstate
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ real (kind=dbl_kind), dimension(:,:,:), intent(inout), optional :: &
+ daidt, & ! change in ice area per time step
+ dvidt, & ! change in ice volume per time step
+ dagedt ! change in ice age per time step
+
+ real (kind=dbl_kind), intent(in), optional :: &
+ offset ! d(age)/dt time offset = dt for thermo, 0 for dyn
+
+ integer (kind=int_kind) :: &
+ iblk, & ! block index
+ i,j, & ! horizontal indices
+ ntrcr, & !
+ nt_iage !
+
+ logical (kind=log_kind) :: &
+ tr_iage !
+
+ character(len=*), parameter :: subname='(update_state)'
+
+ call ice_timer_start(timer_updstate)
+ call icepack_query_tracer_flags(tr_iage_out=tr_iage)
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr)
+ call icepack_query_tracer_indices(nt_iage_out=nt_iage)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-------------------------------------------------------------------
+ ! Ghost cell updates for state variables.
+ !-------------------------------------------------------------------
+
+ call ice_timer_start(timer_bound)
+ call bound_state (aicen, &
+ vicen, vsnon, &
+ ntrcr, trcrn)
+ call ice_timer_stop(timer_bound)
+
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j) SCHEDULE(runtime)
+ do iblk = 1, nblocks
+ do j = 1, ny_block
+ do i = 1, nx_block
+
+ !-----------------------------------------------------------------
+ ! Aggregate the updated state variables (includes ghost cells).
+ !-----------------------------------------------------------------
+
+! if (tmask(i,j,iblk)) &
+ call icepack_aggregate(ncat = ncat, &
+ aicen = aicen(i,j,:,iblk), &
+ trcrn = trcrn(i,j,:,:,iblk), &
+ vicen = vicen(i,j,:,iblk), &
+ vsnon = vsnon(i,j,:,iblk), &
+ aice = aice (i,j, iblk), &
+ trcr = trcr (i,j,:,iblk), &
+ vice = vice (i,j, iblk), &
+ vsno = vsno (i,j, iblk), &
+ aice0 = aice0(i,j, iblk), &
+ ntrcr = ntrcr, &
+ trcr_depend = trcr_depend(:), &
+ trcr_base = trcr_base(:,:), &
+ n_trcr_strata = n_trcr_strata(:), &
+ nt_strata = nt_strata(:,:))
+
+ if (present(offset)) then
+
+ !-----------------------------------------------------------------
+ ! Compute thermodynamic area and volume tendencies.
+ !-----------------------------------------------------------------
+
+ daidt(i,j,iblk) = (aice(i,j,iblk) - daidt(i,j,iblk)) / dt
+ dvidt(i,j,iblk) = (vice(i,j,iblk) - dvidt(i,j,iblk)) / dt
+ if (tr_iage) then
+ if (offset > c0) then ! thermo
+ if (trcr(i,j,nt_iage,iblk) > c0) &
+ dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) &
+ - dagedt(i,j,iblk) - offset) / dt
+ else ! dynamics
+ dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) &
+ - dagedt(i,j,iblk)) / dt
+ endif
+ endif ! tr_iage
+ endif ! present(offset)
+
+ enddo ! i
+ enddo ! j
+ enddo ! iblk
+ !$OMP END PARALLEL DO
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+ call ice_timer_stop(timer_updstate)
+
+ end subroutine update_state
+
+!=======================================================================
+!
+! Run one time step of wave-fracturing the floe size distribution
+!
+! authors: Lettie Roach, NIWA
+! Elizabeth C. Hunke, LANL
+
+ subroutine step_dyn_wave (dt)
+
+ use ice_arrays_column, only: wave_spectrum, &
+ d_afsd_wave, floe_rad_l, floe_rad_c, wavefreq, dwavefreq
+ use ice_domain_size, only: ncat, nfsd, nfreq
+ use ice_state, only: trcrn, aicen, aice, vice
+ use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, &
+ timer_fsd
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ ! local variables
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ iblk, & ! block index
+ i, j ! horizontal indices
+
+ character (len=char_len) :: wave_spec_type
+
+ character(len=*), parameter :: subname = '(step_dyn_wave)'
+
+ call ice_timer_start(timer_column)
+ call ice_timer_start(timer_fsd)
+
+ call icepack_query_parameters(wave_spec_type_out=wave_spec_type)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block)
+ do iblk = 1, nblocks
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+ d_afsd_wave(i,j,:,iblk) = c0
+ call icepack_step_wavefracture (wave_spec_type, &
+ dt, ncat, nfsd, nfreq, &
+ aice (i,j, iblk), &
+ vice (i,j, iblk), &
+ aicen (i,j,:, iblk), &
+ floe_rad_l(:), floe_rad_c(:), &
+ wave_spectrum (i,j,:, iblk), &
+ wavefreq(:), dwavefreq(:), &
+ trcrn (i,j,:,:,iblk), &
+ d_afsd_wave (i,j,:, iblk))
+ end do ! i
+ end do ! j
+ end do ! iblk
+ !$OMP END PARALLEL DO
+
+ call ice_timer_stop(timer_fsd)
+ call ice_timer_stop(timer_column)
+
+ end subroutine step_dyn_wave
+
+!=======================================================================
+!
+! Run one time step of dynamics and horizontal transport.
+! NOTE: The evp and transport modules include boundary updates, so
+! they cannot be done inside a single block loop.
+!
+! authors: William H. Lipscomb, LANL
+! Elizabeth C. Hunke, LANL
+
+ subroutine step_dyn_horiz (dt)
+
+ use ice_boundary, only: ice_HaloUpdate
+ use ice_dyn_evp, only: evp
+ use ice_dyn_eap, only: eap
+ use ice_dyn_vp, only: implicit_solver
+ use ice_dyn_shared, only: kdyn
+ use ice_flux, only: strocnxU, strocnyU, strocnxT_iavg, strocnyT_iavg
+ use ice_flux, only: init_history_dyn
+ use ice_grid, only: grid_average_X2Y
+ use ice_state, only: aiU
+ use ice_transport_driver, only: advection, transport_upwind, transport_remap
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! dynamics time step
+
+ ! local variables
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ iblk, & ! block index
+ i, j ! horizontal indices
+
+ real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: &
+ work1, & ! temporary
+ work2 ! temporary
+
+ character(len=*), parameter :: subname = '(step_dyn_horiz)'
+
+ call init_history_dyn ! initialize dynamic history variables
+
+ !-----------------------------------------------------------------
+ ! Ice dynamics (momentum equation)
+ !-----------------------------------------------------------------
+
+ if (kdyn == 1) call evp (dt)
+ if (kdyn == 2) call eap (dt)
+ if (kdyn == 3) call implicit_solver (dt)
+
+ !-----------------------------------------------------------------
+ ! Compute strocnxT_iavg, strocnyT_iavg for thermo and coupling
+ !-----------------------------------------------------------------
+
+ ! strocn computed on U, N, E as needed. Map strocn U divided by aiU to T
+ ! conservation requires aiU be divided before averaging
+ work1 = c0
+ work2 = c0
+ !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block)
+ do iblk = 1, nblocks
+ this_block = get_block(blocks_ice(iblk), iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+ do j = jlo, jhi
+ do i = ilo, ihi
+ if (aiU(i,j,iblk) /= c0) then
+ work1(i,j,iblk) = strocnxU(i,j,iblk)/aiU(i,j,iblk)
+ work2(i,j,iblk) = strocnyU(i,j,iblk)/aiU(i,j,iblk)
+ endif
+ enddo
+ enddo
+ enddo
+ !$OMP END PARALLEL DO
+ call ice_HaloUpdate (work1, halo_info, &
+ field_loc_NEcorner, field_type_vector)
+ call ice_HaloUpdate (work2, halo_info, &
+ field_loc_NEcorner, field_type_vector)
+ call grid_average_X2Y('F', work1, 'U', strocnxT_iavg, 'T') ! shift
+ call grid_average_X2Y('F', work2, 'U', strocnyT_iavg, 'T')
+
+ !-----------------------------------------------------------------
+ ! Horizontal ice transport
+ !-----------------------------------------------------------------
+
+ if (advection == 'upwind') then
+ call transport_upwind (dt) ! upwind
+ elseif (advection == 'remap') then
+ call transport_remap (dt) ! incremental remapping
+ endif
+
+ end subroutine step_dyn_horiz
+
+!=======================================================================
+!
+! Run one time step of ridging.
+!
+! authors: William H. Lipscomb, LANL
+! Elizabeth C. Hunke, LANL
+
+ subroutine step_dyn_ridge (dt, ndtd, iblk)
+
+ use ice_arrays_column, only: hin_max, fzsal, first_ice
+ use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nblyr
+ use ice_flux, only: &
+ rdg_conv, rdg_shear, dardg1dt, dardg2dt, &
+ dvirdgdt, opening, fpond, fresh, fhocn, &
+ aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, &
+ dvirdgndt, araftn, vraftn, fsalt
+ use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn
+ use ice_grid, only: tmask
+ use ice_state, only: trcrn, vsnon, aicen, vicen, &
+ aice, aice0, trcr_depend, n_trcr_strata, &
+ trcr_base, nt_strata
+ use ice_timers, only: ice_timer_start, ice_timer_stop, timer_column, &
+ timer_ridge
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ ndtd, & ! number of dynamics subcycles
+ iblk ! block index
+
+ ! local variables
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j, & ! horizontal indices
+ ntrcr, & !
+ nbtrcr !
+
+ character(len=*), parameter :: subname = '(step_dyn_ridge)'
+
+ !-----------------------------------------------------------------
+ ! Ridging
+ !-----------------------------------------------------------------
+
+ call ice_timer_start(timer_column,iblk)
+ call ice_timer_start(timer_ridge,iblk)
+
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ this_block = get_block(blocks_ice(iblk), iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+!echmod: this changes the answers, continue using tmask for now
+! call aggregate_area (ncat, aicen(i,j,:,iblk), atmp, atmp0)
+! if (atmp > c0) then
+
+ if (tmask(i,j,iblk)) then
+
+ call icepack_step_ridge (dt=dt, ndtd=ndtd, &
+ nilyr=nilyr, nslyr=nslyr, nblyr=nblyr, &
+ ncat=ncat, n_aero=n_aero, hin_max=hin_max(:), &
+ trcr_depend = trcr_depend (:), &
+ trcr_base = trcr_base (:,:), &
+ n_trcr_strata = n_trcr_strata(:), &
+ nt_strata = nt_strata (:,:), &
+ trcrn = trcrn (i,j,:,:,iblk), &
+ rdg_conv = rdg_conv (i,j, iblk), &
+ rdg_shear = rdg_shear(i,j, iblk), &
+ aicen = aicen (i,j,:,iblk), &
+ vicen = vicen (i,j,:,iblk), &
+ vsnon = vsnon (i,j,:,iblk), &
+ aice0 = aice0 (i,j, iblk), &
+ dardg1dt = dardg1dt (i,j, iblk), &
+ dardg2dt = dardg2dt (i,j, iblk), &
+ dvirdgdt = dvirdgdt (i,j, iblk), &
+ opening = opening (i,j, iblk), &
+ fpond = fpond (i,j, iblk), &
+ fresh = fresh (i,j, iblk), &
+ fhocn = fhocn (i,j, iblk), &
+ faero_ocn = faero_ocn(i,j,:,iblk), &
+!opt fiso_ocn = fiso_ocn (i,j,:,iblk), &
+ aparticn = aparticn (i,j,:,iblk), &
+ krdgn = krdgn (i,j,:,iblk), &
+ aredistn = aredistn (i,j,:,iblk), &
+ vredistn = vredistn (i,j,:,iblk), &
+ dardg1ndt = dardg1ndt(i,j,:,iblk), &
+ dardg2ndt = dardg2ndt(i,j,:,iblk), &
+ dvirdgndt = dvirdgndt(i,j,:,iblk), &
+ araftn = araftn (i,j,:,iblk), &
+ vraftn = vraftn (i,j,:,iblk), &
+ aice = aice (i,j, iblk), &
+ fsalt = fsalt (i,j, iblk), &
+ first_ice = first_ice(i,j,:,iblk), &
+ fzsal = fzsal (i,j, iblk), &
+ flux_bio = flux_bio (i,j,1:nbtrcr,iblk))
+
+ endif ! tmask
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call ice_timer_stop(timer_ridge,iblk)
+ call ice_timer_stop(timer_column,iblk)
+
+ end subroutine step_dyn_ridge
+
+!=======================================================================
+!
+! Updates snow tracers
+!
+! authors: Elizabeth C. Hunke, LANL
+! Nicole Jeffery, LANL
+
+ subroutine step_snow (dt, iblk)
+
+ use ice_calendar, only: nstreams
+ use ice_domain_size, only: ncat, nslyr, nilyr
+ use ice_flux, only: snwcnt, wind, fresh, fhocn, fsloss, fsnow
+ use ice_state, only: trcrn, vsno, vsnon, vicen, aicen, aice
+ use icepack_intfc, only: icepack_step_snow
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ nt_smice, nt_smliq, nt_rsnw, &
+ nt_Tsfc, nt_qice, nt_sice, nt_qsno, &
+ nt_alvl, nt_vlvl, nt_rhos
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j, & ! horizontal indices
+ ns ! history streams index
+
+ real (kind=dbl_kind) :: &
+ puny
+
+ real (kind=dbl_kind) :: &
+ fhs ! flag for presence of snow
+
+ character(len=*), parameter :: subname = '(step_snow)'
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ !-----------------------------------------------------------------
+ ! query icepack values
+ !-----------------------------------------------------------------
+
+ call icepack_query_parameters(puny_out=puny)
+ call icepack_query_tracer_indices( &
+ nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, &
+ nt_rsnw_out=nt_rsnw, nt_Tsfc_out=nt_Tsfc, &
+ nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_qsno_out=nt_qsno, &
+ nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_rhos_out=nt_rhos)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Snow redistribution and metamorphosis
+ !-----------------------------------------------------------------
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ call icepack_step_snow (dt, nilyr, &
+ nslyr, ncat, &
+ wind (i,j, iblk), &
+ aice (i,j, iblk), &
+ aicen(i,j,:,iblk), &
+ vicen(i,j,:,iblk), &
+ vsnon(i,j,:,iblk), &
+ trcrn(i,j,nt_Tsfc,:,iblk), &
+ trcrn(i,j,nt_qice,:,iblk), & ! top layer only
+ trcrn(i,j,nt_sice,:,iblk), & ! top layer only
+ trcrn(i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), &
+ trcrn(i,j,nt_alvl,:,iblk), &
+ trcrn(i,j,nt_vlvl,:,iblk), &
+ trcrn(i,j,nt_smice:nt_smice+nslyr-1,:,iblk), &
+ trcrn(i,j,nt_smliq:nt_smliq+nslyr-1,:,iblk), &
+ trcrn(i,j,nt_rsnw:nt_rsnw+nslyr-1,:,iblk), &
+ trcrn(i,j,nt_rhos:nt_rhos+nslyr-1,:,iblk), &
+ fresh (i,j,iblk), &
+ fhocn (i,j,iblk), &
+ fsloss (i,j,iblk), &
+ fsnow (i,j,iblk))
+ enddo
+ enddo
+
+ ! increment counter for history averaging
+ do j = jlo, jhi
+ do i = ilo, ihi
+ fhs = c0
+ if (vsno(i,j,iblk) > puny) fhs = c1
+ do ns = 1, nstreams
+ snwcnt(i,j,iblk,ns) = snwcnt(i,j,iblk,ns) + fhs
+ enddo
+ enddo
+ enddo
+
+ end subroutine step_snow
+
+!=======================================================================
+!
+! Computes radiation fields
+!
+! authors: William H. Lipscomb, LANL
+! David Bailey, NCAR
+! Elizabeth C. Hunke, LANL
+
+ subroutine step_radiation (dt, iblk)
+
+ use ice_arrays_column, only: ffracn, dhsn, &
+ fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, &
+ fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, &
+ albicen, albsnon, albpndn, &
+ alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, &
+ kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, &
+ gaer_bc_tab, bcenh, swgrid, igrid
+ use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec
+ use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr
+ use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow
+ use ice_grid, only: TLAT, TLON, tmask
+ use ice_state, only: aicen, vicen, vsnon, trcrn
+ use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw
+ use ice_communicate, only: my_task
+ use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ i, j, n, k, & ! horizontal indices
+ ipoint ! index for print diagnostic
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ integer (kind=int_kind) :: &
+ nt_Tsfc, nt_alvl, nt_rsnw, &
+ nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, &
+ ntrcr, nbtrcr, nbtrcr_sw, nt_fbri
+
+ integer (kind=int_kind), dimension(icepack_max_algae) :: &
+ nt_bgc_N
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero_sw, nt_zaero
+
+ logical (kind=log_kind) :: &
+ tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain
+
+ real (kind=dbl_kind), dimension(ncat) :: &
+ fbri ! brine height to ice thickness
+
+ real(kind= dbl_kind), dimension(:,:), allocatable :: &
+ ztrcr_sw, & ! zaerosols (kg/m^3) and chla (mg/m^3)
+ rsnow ! snow grain radius tracer (10^-6 m)
+
+ logical (kind=log_kind) :: &
+ debug, & ! flag for printing debugging information
+ l_print_point ! flag for printing debugging information
+
+ character(len=*), parameter :: subname = '(step_radiation)'
+
+ call ice_timer_start(timer_sw,iblk) ! shortwave
+
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr, &
+ nbtrcr_out=nbtrcr, nbtrcr_sw_out=nbtrcr_sw)
+ call icepack_query_tracer_flags( &
+ tr_brine_out=tr_brine, tr_bgc_N_out=tr_bgc_N, tr_zaero_out=tr_zaero)
+ call icepack_query_tracer_indices( &
+ nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_rsnw_out=nt_rsnw, &
+ nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, &
+ nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, &
+ nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N)
+ call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero, &
+ snwgrain_out=snwgrain)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ allocate(ztrcr_sw(nbtrcr_sw,ncat))
+ allocate(rsnow(nslyr,ncat))
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ l_print_point = .false.
+ debug = .false.
+ if (debug .and. print_points) then
+ do ipoint = 1, npnt
+ if (my_task == pmloc(ipoint) .and. &
+ i == piloc(ipoint) .and. &
+ j == pjloc(ipoint)) &
+ l_print_point = .true.
+ write (nu_diag, *) 'my_task = ',my_task
+ enddo ! ipoint
+ endif
+ fbri (:) = c0
+ ztrcr_sw(:,:) = c0
+ rsnow (:,:) = c0
+ do n = 1, ncat
+ if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk)
+ if (snwgrain) then
+ do k = 1, nslyr
+ rsnow(k,n) = trcrn(i,j,nt_rsnw+k-1,n,iblk)
+ enddo
+ endif
+ enddo
+
+ if (tmask(i,j,iblk)) then
+
+ call icepack_step_radiation (dt=dt, ncat=ncat, &
+ nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, &
+ dEdd_algae=dEdd_algae, &
+ swgrid=swgrid(:), igrid=igrid(:), &
+ fbri=fbri(:), &
+ aicen=aicen(i,j, :,iblk), &
+ vicen=vicen(i,j, :,iblk), &
+ vsnon=vsnon(i,j, :,iblk), &
+ Tsfcn=trcrn(i,j,nt_Tsfc,:,iblk), &
+ alvln=trcrn(i,j,nt_alvl,:,iblk), &
+ apndn=trcrn(i,j,nt_apnd,:,iblk), &
+ hpndn=trcrn(i,j,nt_hpnd,:,iblk), &
+ ipndn=trcrn(i,j,nt_ipnd,:,iblk), &
+ aeron=trcrn(i,j,nt_aero:nt_aero+4*n_aero-1,:,iblk), &
+ bgcNn=trcrn(i,j,nt_bgc_N(1):nt_bgc_N(1)+n_algae*(nblyr+3)-1,:,iblk), &
+ zaeron=trcrn(i,j,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:,iblk), &
+ trcrn_bgcsw=ztrcr_sw, &
+ TLAT=TLAT(i,j,iblk), TLON=TLON(i,j,iblk), &
+ calendar_type=calendar_type, &
+ days_per_year=days_per_year, &
+ nextsw_cday=nextsw_cday, yday=yday, &
+ sec=msec, &
+ kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), &
+ waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), &
+ gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), &
+ bcenh=bcenh(:,:,:), &
+ modal_aero=modal_aero, &
+ swvdr =swvdr (i,j ,iblk), swvdf =swvdf (i,j ,iblk), &
+ swidr =swidr (i,j ,iblk), swidf =swidf (i,j ,iblk), &
+ coszen =coszen (i,j ,iblk), fsnow =fsnow (i,j ,iblk), &
+ alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), &
+ alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), &
+ fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), &
+ fswthrun =fswthrun (i,j,: ,iblk), &
+!opt fswthrun_vdr =fswthrun_vdr (i,j,: ,iblk), &
+!opt fswthrun_vdf =fswthrun_vdf (i,j,: ,iblk), &
+!opt fswthrun_idr =fswthrun_idr (i,j,: ,iblk), &
+!opt fswthrun_idf =fswthrun_idf (i,j,: ,iblk), &
+ fswpenln=fswpenln(i,j,:,:,iblk), &
+ Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), &
+ albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), &
+ albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), &
+ snowfracn=snowfracn(i,j,: ,iblk), &
+ dhsn =dhsn (i,j,: ,iblk), ffracn =ffracn(i,j,:,iblk), &
+!opt rsnow =rsnow (:,:), &
+ l_print_point=l_print_point)
+ endif
+
+ if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then
+ do n = 1, ncat
+ do k = 1, nbtrcr_sw
+ trcrn_sw(i,j,k,n,iblk) = ztrcr_sw(k,n)
+ enddo
+ enddo
+ endif
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ deallocate(ztrcr_sw)
+ deallocate(rsnow)
+
+ call ice_timer_stop(timer_sw,iblk) ! shortwave
+
+ end subroutine step_radiation
+
+!=======================================================================
+! Ocean mixed layer calculation (internal to sea ice model).
+! Allows heat storage in ocean for uncoupled runs.
+!
+! authors: John Weatherly, CRREL
+! C.M. Bitz, UW
+! Elizabeth C. Hunke, LANL
+! Bruce P. Briegleb, NCAR
+! William H. Lipscomb, LANL
+
+ subroutine ocean_mixed_layer (dt, iblk)
+
+ use ice_arrays_column, only: Cdn_atm, Cdn_atm_ratio
+ use ice_flux, only: sst, Tf, Qa, uatmT, vatmT, wind, potT, rhoa, zlvl, &
+ frzmlt, fhocn, fswthru, flw, flwout_ocn, fsens_ocn, flat_ocn, evap_ocn, &
+ alvdr_ocn, alidr_ocn, alvdf_ocn, alidf_ocn, swidf, swvdf, swidr, swvdr, &
+ qdp, hmix, strairx_ocn, strairy_ocn, Tref_ocn, Qref_ocn
+ use ice_grid, only: tmask
+ use ice_state, only: aice
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ real (kind=dbl_kind) :: albocn
+
+ real (kind=dbl_kind), parameter :: &
+ frzmlt_max = c1000 ! max magnitude of frzmlt (W/m^2)
+
+ integer (kind=int_kind) :: &
+ i, j , & ! horizontal indices
+ ij ! combined ij index
+
+ real (kind=dbl_kind), dimension(nx_block,ny_block) :: &
+ delt , & ! potential temperature difference (K)
+ delq , & ! specific humidity difference (kg/kg)
+ shcoef, & ! transfer coefficient for sensible heat
+ lhcoef ! transfer coefficient for latent heat
+
+ integer (kind=int_kind) :: &
+ icells ! number of ocean cells
+
+ integer (kind=int_kind), dimension(nx_block*ny_block) :: &
+ indxi, indxj ! compressed indices for ocean cells
+
+ character(len=*), parameter :: subname = '(ocn_mixed_layer)'
+
+ !-----------------------------------------------------------------
+
+ call icepack_query_parameters(albocn_out=albocn)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Identify ocean cells.
+ ! Set fluxes to zero in land cells.
+ !-----------------------------------------------------------------
+
+ icells = 0
+ indxi(:) = 0
+ indxj(:) = 0
+
+ do j = 1, ny_block
+ do i = 1, nx_block
+
+ if (tmask(i,j,iblk)) then
+ icells = icells + 1
+ indxi(icells) = i
+ indxj(icells) = j
+ else
+ sst (i,j,iblk) = c0
+ frzmlt (i,j,iblk) = c0
+ flwout_ocn(i,j,iblk) = c0
+ fsens_ocn (i,j,iblk) = c0
+ flat_ocn (i,j,iblk) = c0
+ evap_ocn (i,j,iblk) = c0
+ endif
+ enddo ! i
+ enddo ! j
+
+ !-----------------------------------------------------------------
+ ! Compute boundary layer quantities
+ !-----------------------------------------------------------------
+
+ do ij = 1, icells
+ i = indxi(ij)
+ j = indxj(ij)
+
+ call icepack_atm_boundary(sfctype = 'ocn', &
+ Tsf = sst (i,j,iblk), &
+ potT = potT (i,j,iblk), &
+ uatm = uatmT (i,j,iblk), &
+ vatm = vatmT (i,j,iblk), &
+ wind = wind (i,j,iblk), &
+ zlvl = zlvl (i,j,iblk), &
+ Qa = Qa (i,j,iblk), &
+ rhoa = rhoa (i,j,iblk), &
+ strx = strairx_ocn(i,j,iblk), &
+ stry = strairy_ocn(i,j,iblk), &
+ Tref = Tref_ocn (i,j,iblk), &
+ Qref = Qref_ocn (i,j,iblk), &
+ delt = delt (i,j), &
+ delq = delq (i,j), &
+ lhcoef = lhcoef (i,j), &
+ shcoef = shcoef (i,j), &
+ Cdn_atm = Cdn_atm (i,j,iblk), &
+ Cdn_atm_ratio_n = Cdn_atm_ratio(i,j,iblk))
+ enddo ! ij
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ !-----------------------------------------------------------------
+ ! Ocean albedo
+ ! For now, assume albedo = albocn in each spectral band.
+ !-----------------------------------------------------------------
+
+ alvdr_ocn(:,:,iblk) = albocn
+ alidr_ocn(:,:,iblk) = albocn
+ alvdf_ocn(:,:,iblk) = albocn
+ alidf_ocn(:,:,iblk) = albocn
+
+ !-----------------------------------------------------------------
+ ! Compute ocean fluxes and update SST
+ !-----------------------------------------------------------------
+
+ do ij = 1, icells
+ i = indxi(ij)
+ j = indxj(ij)
+
+ call icepack_ocn_mixed_layer(alvdr_ocn=alvdr_ocn(i,j,iblk), swvdr =swvdr (i,j,iblk), &
+ alidr_ocn=alidr_ocn(i,j,iblk), swidr =swidr (i,j,iblk), &
+ alvdf_ocn=alvdf_ocn(i,j,iblk), swvdf =swvdf (i,j,iblk), &
+ alidf_ocn=alidf_ocn(i,j,iblk), swidf =swidf (i,j,iblk), &
+ sst =sst (i,j,iblk), flwout_ocn=flwout_ocn(i,j,iblk), &
+ fsens_ocn=fsens_ocn(i,j,iblk), shcoef=shcoef(i,j), &
+ flat_ocn =flat_ocn (i,j,iblk), lhcoef=lhcoef(i,j), &
+ evap_ocn =evap_ocn (i,j,iblk), flw =flw (i,j,iblk), &
+ delt =delt (i,j), delq =delq (i,j), &
+ aice =aice (i,j,iblk), fhocn =fhocn (i,j,iblk), &
+ fswthru =fswthru (i,j,iblk), hmix =hmix (i,j,iblk), &
+ Tf =Tf (i,j,iblk), qdp =qdp (i,j,iblk), &
+ frzmlt =frzmlt (i,j,iblk), dt =dt)
+ enddo ! ij
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ end subroutine ocean_mixed_layer
+
+!=======================================================================
+
+ subroutine biogeochemistry (dt, iblk)
+
+ use ice_arrays_column, only: upNO, upNH, iDi, iki, zfswin, &
+ zsal_tot, darcy_V, grow_net, &
+ PP_net, hbri,dhbr_bot, dhbr_top, Zoo,&
+ fbio_snoice, fbio_atmice, ocean_bio, &
+ first_ice, fswpenln, bphi, bTiz, ice_bio_net, &
+ snow_bio_net, fswthrun, Rayleigh_criteria, &
+ ocean_bio_all, sice_rho, fzsal, fzsal_g, &
+ bgrid, igrid, icgrid, cgrid
+ use ice_domain_size, only: nblyr, nilyr, nslyr, n_algae, n_zaero, ncat, &
+ n_doc, n_dic, n_don, n_fed, n_fep
+ use ice_flux, only: meltbn, melttn, congeln, snoicen, &
+ sst, sss, fsnow, meltsn
+ use ice_flux_bgc, only: hin_old, flux_bio, flux_bio_atm, faero_atm, &
+ nit, amm, sil, dmsp, dms, algalN, doc, don, dic, fed, fep, zaeros, hum
+ use ice_state, only: aicen_init, vicen_init, aicen, vicen, vsnon, &
+ trcrn, vsnon_init, aice0
+ use ice_timers, only: timer_bgc, ice_timer_start, ice_timer_stop
+
+ real (kind=dbl_kind), intent(in) :: &
+ dt ! time step
+
+ integer (kind=int_kind), intent(in) :: &
+ iblk ! block index
+
+ ! local variables
+
+ integer (kind=int_kind) :: &
+ i, j , & ! horizontal indices
+ ilo,ihi,jlo,jhi, & ! beginning and end of physical domain
+ mm ! tracer index
+
+ type (block) :: &
+ this_block ! block information for current block
+
+ integer (kind=int_kind) :: &
+ nbtrcr, ntrcr
+
+ integer (kind=int_kind), dimension(icepack_max_aero) :: &
+ nlt_zaero
+
+ integer (kind=int_kind), dimension(icepack_max_nbtrcr) :: &
+ bio_index_o
+
+ logical (kind=log_kind) :: &
+ skl_bgc, tr_brine, tr_zaero
+
+ character(len=*), parameter :: subname='(biogeochemistry)'
+
+ call icepack_query_tracer_flags(tr_brine_out=tr_brine)
+ call icepack_query_parameters(skl_bgc_out=skl_bgc)
+ call icepack_query_tracer_sizes(ntrcr_out=ntrcr, nbtrcr_out=nbtrcr)
+ call icepack_query_tracer_flags(tr_zaero_out=tr_zaero)
+ call icepack_query_tracer_indices(nlt_zaero_out=nlt_zaero)
+ call icepack_query_tracer_indices(bio_index_o_out=bio_index_o)
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ if (tr_brine .or. skl_bgc) then
+
+ call ice_timer_start(timer_bgc,iblk) ! biogeochemistry
+
+ this_block = get_block(blocks_ice(iblk),iblk)
+ ilo = this_block%ilo
+ ihi = this_block%ihi
+ jlo = this_block%jlo
+ jhi = this_block%jhi
+
+ ! Define ocean concentrations for tracers used in simulation
+ do j = jlo, jhi
+ do i = ilo, ihi
+
+ call icepack_load_ocean_bio_array(max_nbtrcr = icepack_max_nbtrcr, &
+ max_algae = icepack_max_algae, max_don = icepack_max_don, &
+ max_doc = icepack_max_doc, max_dic = icepack_max_dic, &
+ max_aero = icepack_max_aero, max_fe = icepack_max_fe, &
+ nit = nit(i,j, iblk), amm = amm (i,j, iblk), &
+ sil = sil(i,j, iblk), dmsp = dmsp (i,j, iblk), &
+ dms = dms(i,j, iblk), algalN = algalN(i,j,:,iblk), &
+ doc = doc(i,j,:,iblk), don = don (i,j,:,iblk), &
+ dic = dic(i,j,:,iblk), fed = fed (i,j,:,iblk), &
+ fep = fep(i,j,:,iblk), zaeros = zaeros(i,j,:,iblk), &
+ hum = hum(i,j, iblk), &
+ ocean_bio_all = ocean_bio_all(i,j,:,iblk))
+
+ do mm = 1,nbtrcr
+ ocean_bio(i,j,mm,iblk) = ocean_bio_all(i,j,bio_index_o(mm),iblk)
+ enddo ! mm
+ if (tr_zaero) then
+ do mm = 1, n_zaero ! update aerosols
+ flux_bio_atm(i,j,nlt_zaero(mm),iblk) = faero_atm(i,j,mm,iblk)
+ enddo ! mm
+ endif
+
+ call icepack_biogeochemistry(dt=dt, ntrcr=ntrcr, nbtrcr=nbtrcr,&
+ bgrid=bgrid, igrid=igrid, icgrid=icgrid, cgrid=cgrid, &
+ nblyr=nblyr, nilyr=nilyr, nslyr=nslyr, n_algae=n_algae, n_zaero=n_zaero, &
+ ncat=ncat, n_doc=n_doc, n_dic=n_dic, n_don=n_don, n_fed=n_fed, n_fep=n_fep, &
+ upNO = upNO (i,j, iblk), &
+ upNH = upNH (i,j, iblk), &
+ iDi = iDi (i,j,:,:, iblk), &
+ iki = iki (i,j,:,:, iblk), &
+ zfswin = zfswin (i,j,:,:, iblk), &
+ zsal_tot = zsal_tot (i,j, iblk), &
+ darcy_V = darcy_V (i,j,:, iblk), &
+ grow_net = grow_net (i,j, iblk), &
+ PP_net = PP_net (i,j, iblk), &
+ hbri = hbri (i,j, iblk), &
+ dhbr_bot = dhbr_bot (i,j,:, iblk), &
+ dhbr_top = dhbr_top (i,j,:, iblk), &
+ Zoo = Zoo (i,j,:,:, iblk), &
+ fbio_snoice = fbio_snoice (i,j,:, iblk), &
+ fbio_atmice = fbio_atmice (i,j,:, iblk), &
+ ocean_bio = ocean_bio (i,j,1:nbtrcr, iblk), &
+ first_ice = first_ice (i,j,:, iblk), &
+ fswpenln = fswpenln (i,j,:,:, iblk), &
+ bphi = bphi (i,j,:,:, iblk), &
+ bTiz = bTiz (i,j,:,:, iblk), &
+ ice_bio_net = ice_bio_net (i,j,1:nbtrcr, iblk), &
+ snow_bio_net = snow_bio_net(i,j,1:nbtrcr, iblk), &
+ fswthrun = fswthrun (i,j,:, iblk), &
+ sice_rho = sice_rho (i,j,:, iblk), &
+ fzsal = fzsal (i,j, iblk), &
+ fzsal_g = fzsal_g (i,j, iblk), &
+ meltbn = meltbn (i,j,:, iblk), &
+ melttn = melttn (i,j,:, iblk), &
+ congeln = congeln (i,j,:, iblk), &
+ snoicen = snoicen (i,j,:, iblk), &
+ sst = sst (i,j, iblk), &
+ sss = sss (i,j, iblk), &
+ fsnow = fsnow (i,j, iblk), &
+ meltsn = meltsn (i,j,:, iblk), &
+ hin_old = hin_old (i,j,:, iblk), &
+ flux_bio = flux_bio (i,j,1:nbtrcr, iblk), &
+ flux_bio_atm = flux_bio_atm(i,j,1:nbtrcr, iblk), &
+ aicen_init = aicen_init (i,j,:, iblk), &
+ vicen_init = vicen_init (i,j,:, iblk), &
+ aicen = aicen (i,j,:, iblk), &
+ vicen = vicen (i,j,:, iblk), &
+ vsnon = vsnon (i,j,:, iblk), &
+ aice0 = aice0 (i,j, iblk), &
+ trcrn = trcrn (i,j,:,:, iblk), &
+ vsnon_init = vsnon_init (i,j,:, iblk), &
+ Rayleigh_criteria = Rayleigh_criteria(i,j,iblk), &
+ skl_bgc = skl_bgc)
+
+ enddo ! i
+ enddo ! j
+
+ call icepack_warnings_flush(nu_diag)
+ if (icepack_warnings_aborted()) call abort_ice(error_message=subname, &
+ file=__FILE__, line=__LINE__)
+
+ call ice_timer_stop(timer_bgc,iblk) ! biogeochemistry
+
+ endif ! tr_brine .or. skl_bgc
+
+ end subroutine biogeochemistry
+
+!=======================================================================
+
+ end module ice_step_mod
+
+!=======================================================================
diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile
index 872f426ad..d109472b0 100644
--- a/configuration/scripts/Makefile
+++ b/configuration/scripts/Makefile
@@ -74,7 +74,7 @@ AR := ar
.SUFFIXES:
-.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs
+.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk sumchk bcstchk gridavgchk halochk optargs opticep
all: $(EXEC)
cice: $(EXEC)
@@ -93,7 +93,7 @@ targets:
@echo " "
@echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean"
@echo " Diagnostics: targets, db_files, db_flags"
- @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs"
+ @echo " Unit Tests : helloworld, calchk, sumchk, bcstchk, gridavgchk, halochk, optargs, opticep"
target: targets
db_files:
@@ -153,6 +153,8 @@ gridavgchk: $(EXEC)
halochk: $(EXEC)
+opticep: $(EXEC)
+
# this builds just a subset of source code specified explicitly and requires a separate target
HWOBJS := helloworld.o
diff --git a/configuration/scripts/options/set_env.opticep b/configuration/scripts/options/set_env.opticep
new file mode 100644
index 000000000..81339ea42
--- /dev/null
+++ b/configuration/scripts/options/set_env.opticep
@@ -0,0 +1,2 @@
+setenv ICE_DRVOPT unittest/opticep
+setenv ICE_TARGET opticep
diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script
index 2700fe71f..a24236c9e 100644
--- a/configuration/scripts/tests/baseline.script
+++ b/configuration/scripts/tests/baseline.script
@@ -33,8 +33,13 @@ if (${ICE_BASECOM} != ${ICE_SPVAL}) then
echo "base_file: ${base_file}"
echo "test_file: ${test_file}"
- ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile
- set bfbstatus = $status
+ if (${ICE_TARGET} == "opticep") then
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile
+ set bfbstatus = $status
+ else
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile
+ set bfbstatus = $status
+ endif
else if (${ICE_BFBTYPE} =~ qcchk*) then
set test_dir = ${ICE_RUNDIR}
@@ -160,8 +165,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then
echo "base_file: ${base_file}"
echo "test_file: ${test_file}"
- ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file}
- set bfbstatus = $status
+ if (${ICE_TARGET} == "opticep") then
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile
+ set bfbstatus = $status
+ else
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file}
+ set bfbstatus = $status
+ endif
else if (${ICE_BFBTYPE} == "logrest") then
set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1`
@@ -172,8 +182,13 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then
echo "base_file: ${base_file}"
echo "test_file: ${test_file}"
- ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file}
- set bfbstatusl = $status
+ if (${ICE_TARGET} == "opticep") then
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} modcicefile
+ set bfbstatus = $status
+ else
+ ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file}
+ set bfbstatusl = $status
+ endif
set test_dir = ${ICE_RUNDIR}/restart
set base_dir = ${ICE_RUNDIR}/../${ICE_BFBCOMP}.${ICE_TESTID}/restart
diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh
index 576289cd7..6659906b8 100755
--- a/configuration/scripts/tests/comparelog.csh
+++ b/configuration/scripts/tests/comparelog.csh
@@ -16,6 +16,7 @@
set filearg = 0
set cicefile = 0
set notcicefile = "notcicefile"
+set modcicefile = "modcicefile"
if ( $#argv == 2 ) then
set cicefile = 1
set filearg = 1
@@ -23,12 +24,18 @@ if ( $#argv == 2 ) then
set test_data = $argv[2]
if ("$argv[1]" == "${notcicefile}") set filearg = 0
if ("$argv[2]" == "${notcicefile}") set filearg = 0
+ if ("$argv[1]" == "${modcicefile}") set filearg = 0
+ if ("$argv[2]" == "${modcicefile}") set filearg = 0
else if ( $#argv == 3 ) then
set cicefile = 0
set filearg = 1
set base_data = $argv[1]
set test_data = $argv[2]
- if ("$argv[3]" != "${notcicefile}") set filearg = 0
+ if ("$argv[3]" == "${modcicefile}") then
+ set cicefile = 2
+ else if ("$argv[3]" != "${notcicefile}") then
+ set filearg = 0
+ endif
endif
if (${filearg} == 0) then
@@ -57,6 +64,9 @@ if (${filearg} == 1) then
if (${cicefile} == 1) then
cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${base_out}
cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" | grep -iv "init_vert" | grep -iv "ridge_ice" >&! ${test_out}
+ else if (${cicefile} == 2) then
+ cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${base_out}
+ cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e "total " -e "arwt " -e "max " -e "kinetic" >&! ${test_out}
else
sed -n '/RunningUnitTest/,$p' ${base_data} >! ${base_out}
sed -n '/RunningUnitTest/,$p' ${test_data} >! ${test_out}
diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts
index e64bea2f7..840fc822e 100644
--- a/configuration/scripts/tests/unittest_suite.ts
+++ b/configuration/scripts/tests/unittest_suite.ts
@@ -1,6 +1,7 @@
# Test Grid PEs Sets BFB-compare
+smoke gx3 8x2 diag1,run5day
+smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2
unittest gx3 1x1 helloworld
-unittest gx3 1x1 optargs
unittest gx3 1x1 calchk,short
unittest gx3 4x1x25x29x4 sumchk
unittest gx3 1x1x25x29x16 sumchk
@@ -28,3 +29,7 @@ unittest tx1 4x2 halochk,dwblockall
unittest tx1 4x2 halochk,dwblockall,tripolet
unittest tx1 4x2x65x45x10 halochk,dwblockall
unittest tx1 4x2x57x43x12 halochk,dwblockall,tripolet
+unittest gx3 1x1 optargs
+unittest gx3 1x1 opticep
+unittest gx3 4x2x25x29x4 debug,run2day,dslenderX2,opticep,cmplog smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day
+unittest gx3 8x2 diag1,run5day,opticep,cmplog smoke_gx3_8x2_diag1_run5day
diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst
index f04bdf19a..e382eba17 100644
--- a/doc/source/user_guide/ug_testing.rst
+++ b/doc/source/user_guide/ug_testing.rst
@@ -742,6 +742,8 @@ The following are brief descriptions of some of the current unit tests,
in the Makefile
- **optargs** is a unit test that tests passing optional arguments down a calling tree and verifying
that the optional attribute is preserved correctly.
+ - **opticep** is a cice test that turns off the icepack optional arguments passed into icepack. This
+ can only be run with a subset of CICE/Icepack cases to verify the optional arguments are working correctly.
- **sumchk** is a unit test that exercises the methods in ice_global_reductions.F90. This test requires
that a CICE grid and decomposition be initialized, so CICE_InitMod.F90 is leveraged to initialize
the model prior to running a suite of unit validation tests to verify correctness.
diff --git a/icepack b/icepack
index d024340f1..4728746ea 160000
--- a/icepack
+++ b/icepack
@@ -1 +1 @@
-Subproject commit d024340f19676bc5f6c0effe0c5dbfb763a5882a
+Subproject commit 4728746ea2926bf10acc5de354b3eae16d418af5