From 041cb5604fea5f04d3912f15db91fb079e046097 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 18 Jul 2023 19:33:02 -0600 Subject: [PATCH] Update Icepack to Consortium main #4728746, July 18 2023 - fix optional arguments issues - fix hsn_new(1) bug Update optargs unit test, add new test cases Add opticep unit test, to test CICE calls to Icepack without optional arguments. Add new comparison option to comparelog.csh to compare a unit test with a standard CICE test. Update unittest_suite Update documentation about optional arguments and unit tests --- cicecore/drivers/unittest/optargs/optargs.F90 | 160 +- .../drivers/unittest/optargs/optargs_subs.F90 | 116 +- cicecore/drivers/unittest/opticep/CICE.F90 | 59 + .../unittest/opticep/CICE_FinalMod.F90 | 71 + .../drivers/unittest/opticep/CICE_InitMod.F90 | 517 +++ .../drivers/unittest/opticep/CICE_RunMod.F90 | 741 ++++ cicecore/drivers/unittest/opticep/README | 30 + .../unittest/opticep/ice_init_column.F90 | 3135 +++++++++++++++++ .../drivers/unittest/opticep/ice_step_mod.F90 | 1784 ++++++++++ configuration/scripts/Makefile | 6 +- configuration/scripts/options/set_env.opticep | 2 + configuration/scripts/tests/baseline.script | 27 +- configuration/scripts/tests/comparelog.csh | 12 +- configuration/scripts/tests/unittest_suite.ts | 7 +- doc/source/user_guide/ug_testing.rst | 2 + icepack | 2 +- 16 files changed, 6582 insertions(+), 89 deletions(-) create mode 100644 cicecore/drivers/unittest/opticep/CICE.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_FinalMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_InitMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/CICE_RunMod.F90 create mode 100644 cicecore/drivers/unittest/opticep/README create mode 100644 cicecore/drivers/unittest/opticep/ice_init_column.F90 create mode 100644 cicecore/drivers/unittest/opticep/ice_step_mod.F90 create mode 100644 configuration/scripts/options/set_env.opticep 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