From e6bdf868a279c60a4986791f7bd66d47ec4726fa Mon Sep 17 00:00:00 2001 From: JFLemieux73 <31927797+JFLemieux73@users.noreply.github.com> Date: Wed, 14 Jul 2021 19:15:18 -0400 Subject: [PATCH 01/15] New fig for Bgrid + minor modifs to comments and doc (#616) --- cicecore/cicedynB/dynamics/ice_dyn_eap.F90 | 12 ++--- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 12 ++--- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 16 +++---- cicecore/cicedynB/dynamics/ice_dyn_vp.F90 | 44 +++++++++--------- cicecore/cicedynB/infrastructure/ice_grid.F90 | 24 +++++----- doc/source/user_guide/figures/CICE_Bgrid.png | Bin 0 -> 53070 bytes doc/source/user_guide/ug_implementation.rst | 39 +++++++++++----- 7 files changed, 81 insertions(+), 66 deletions(-) create mode 100755 doc/source/user_guide/figures/CICE_Bgrid.png diff --git a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 index 2face07c2..9c52bb888 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 @@ -1206,12 +1206,12 @@ subroutine stress_eap (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index 2206e0de7..b796488b7 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -610,12 +610,12 @@ subroutine stress (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear , & ! 1/tarea tinyarea ! puny*tarea diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 index f3685ed61..f59c27f20 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -1204,10 +1204,10 @@ subroutine deformations (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tarear ! 1/tarea real (kind=dbl_kind), dimension (nx_block,ny_block), & @@ -1305,10 +1305,10 @@ subroutine strain_rates (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), intent(out):: & ! at each corner : divune, divunw, divuse, divusw , & ! divergence diff --git a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 index 457a73ade..860865dba 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 @@ -1149,12 +1149,12 @@ subroutine calc_zeta_dPr (nx_block, ny_block, & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm , & ! 0.5*HTN - 1.5*HTS tinyarea ! min_strain_rate*tarea real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(out) :: & @@ -1335,10 +1335,10 @@ subroutine stress_vp (nx_block , ny_block , & vvel , & ! y-component of velocity (m/s) dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & zetaD ! 2*zeta @@ -1555,12 +1555,12 @@ subroutine matvec (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & uvel , & ! x-component of velocity (m/s) @@ -2004,12 +2004,12 @@ subroutine formDiag_step1 (nx_block, ny_block, & real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & dxt , & ! width of T-cell through the middle (m) dyt , & ! height of T-cell through the middle (m) - dxhy , & ! 0.5*(HTE - HTE) - dyhx , & ! 0.5*(HTN - HTN) - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm ! 0.5*HTN - 1.5*HTN + dxhy , & ! 0.5*(HTE - HTW) + dyhx , & ! 0.5*(HTN - HTS) + cyp , & ! 1.5*HTE - 0.5*HTW + cxp , & ! 1.5*HTN - 0.5*HTS + cym , & ! 0.5*HTE - 1.5*HTW + cxm ! 0.5*HTN - 1.5*HTS real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & zetaD ! 2*zeta diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 2124bbebe..9ce22a6f4 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -78,12 +78,12 @@ module ice_grid ! gridcell value of [1 - (land fraction)] (T-cell) real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - cyp , & ! 1.5*HTE - 0.5*HTE - cxp , & ! 1.5*HTN - 0.5*HTN - cym , & ! 0.5*HTE - 1.5*HTE - cxm , & ! 0.5*HTN - 1.5*HTN - dxhy , & ! 0.5*(HTE - HTE) - dyhx ! 0.5*(HTN - HTN) + cyp , & ! 1.5*HTE(i,j)-0.5*HTW(i,j) = 1.5*HTE(i,j)-0.5*HTE(i-1,j) + cxp , & ! 1.5*HTN(i,j)-0.5*HTS(i,j) = 1.5*HTN(i,j)-0.5*HTN(i,j-1) + cym , & ! 0.5*HTE(i,j)-1.5*HTW(i,j) = 0.5*HTE(i,j)-1.5*HTE(i-1,j) + cxm , & ! 0.5*HTN(i,j)-1.5*HTS(i,j) = 0.5*HTN(i,j)-1.5*HTN(i,j-1) + dxhy , & ! 0.5*(HTE(i,j) - HTW(i,j)) = 0.5*(HTE(i,j) - HTE(i-1,j)) + dyhx ! 0.5*(HTN(i,j) - HTS(i,j)) = 0.5*(HTN(i,j) - HTN(i,j-1)) ! grid dimensions for rectangular grid real (kind=dbl_kind), public :: & @@ -175,12 +175,12 @@ subroutine alloc_grid ANGLET (nx_block,ny_block,max_blocks), & ! ANGLE converted to T-cells bathymetry(nx_block,ny_block,max_blocks),& ! ocean depth, for grounding keels and bergs (m) ocn_gridcell_frac(nx_block,ny_block,max_blocks),& ! only relevant for lat-lon grids - cyp (nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTE - cxp (nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTN - cym (nx_block,ny_block,max_blocks), & ! 0.5*HTE - 1.5*HTE - cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTN - dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTE) - dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTN) + cyp (nx_block,ny_block,max_blocks), & ! 1.5*HTE - 0.5*HTW + cxp (nx_block,ny_block,max_blocks), & ! 1.5*HTN - 0.5*HTS + cym (nx_block,ny_block,max_blocks), & ! 0.5*HTE - 1.5*HTW + cxm (nx_block,ny_block,max_blocks), & ! 0.5*HTN - 1.5*HTS + dxhy (nx_block,ny_block,max_blocks), & ! 0.5*(HTE - HTW) + dyhx (nx_block,ny_block,max_blocks), & ! 0.5*(HTN - HTS) xav (nx_block,ny_block,max_blocks), & ! mean T-cell value of x yav (nx_block,ny_block,max_blocks), & ! mean T-cell value of y xxav (nx_block,ny_block,max_blocks), & ! mean T-cell value of xx diff --git a/doc/source/user_guide/figures/CICE_Bgrid.png b/doc/source/user_guide/figures/CICE_Bgrid.png new file mode 100755 index 0000000000000000000000000000000000000000..09356a0c6223beccd539393ca28e722c0767c861 GIT binary patch literal 53070 zcmd?R2UJsAyC@ozA|Oo!R5~a~M+}52NU|AkgW;GlU=z-V^iAkH7=G=MQenf-+kfu)qbr*-hw85GW^zbjOGQxF)u}qx~EN zqNBq7hu6%pA`Jqy{<uV>zgB z&k|B{ZnA-ObSIK|#rSqM=VOl1oy8#WP0jIb?5<{cRG4;Hnw?4J)b{R@~n!;|CQaTYIs~8jBM(iyz9$Ox7KnN0uGB|mh8y)*#x-;Y{hL0=Lr*|Kkf6LHeX(*`a>&c(D^>$b7is)*g=XP{MV0bP) ze*4UidTh7fNtAUbH{WwJnt0zf*)qmt>!FiqVgw^UC&E$4C2I+7k=z{VSY(v*e53wJ zL!Db2zqIV=Y;XS3%ty2FhALKRJs%^%DM|F!QsrKyN2~Q2j;XA@hRQQ3WPy;%-9cUH zy%9fVrm)F{UCbDdljK}0eQva&wATdlSsOo|XOOcfjb*EFhnm{Kt4dl;-?Y2C>?}4f zE$=SpLk8Ye+lNWUnCM@DI^LNR(vg_IWmKXV-;!$`P+^lBLfn6i7pxCgI~q0^YU`() zN9}^lq;dKpsDGu+R2!l&!4{LecxX;MCuBYdTrM-%n0(1mBw>cb=AevDe5ho_D8 z@y=ZOMW!igP?5=a3`*%}_@Ll32+6-vO-AkX#ZL8Bm_MdW9Y-^65ch4r++TNb^hOrZ zhowQ7U902bKYld(mQK%c%nITC80;CozfgdGX|?&X4L;k_v=7d+}+)3 zSOX8Lm(f=LK#Vxt=yLOY()raJM>9zZx4TL^ivtY*sTCZ5e`NZf3*z4mv^+Cy!@MlQ z`^75j$-w<*5QK_~)Y{LCjR<|mz5*8wCQ;k(aW`%qC=Ea`t+orLr>B3ulD=M;QpA`O z3gctooxin~x(8RNY-v?_Ch?dHtt0yIaO7ly*WQ3++U^{e^=)1gT~eaJQdJN7z0B)v zlF#jyn>cM^%uq=sjMx4^N&YPL;!M|2MRBnh#O6n{qsnvZPsdu=>u_5^Gd~$}Q@I^) zT{~VF8;QmY5E z{I$fG=J%XOW~r&0|Ep=$VK(&07Dwy=+teRSkUz2#tCVi*lA5Np*+=W&DhxG_uw@rJ z-bT2okU?q&uUc6TDm$XeRjkX+{9;C|&x>pzog}XhCXT^LVf6tI3thDJi`7b3jEV`{{J%Y#ZLY9I?i0T7H-&&KXMY~;|sB2_G}+4O5}zF zb)c2=B1<_2EZV6fl1PIqEhr-Rhmwbz@@YHw=q)6zYv1 z8k0KAX-EHlzmR%~>QTzjgNo`R^N$;G>@|Vq0@@o(izHbVRjBVda#6En|XX_+Vh5mZ2ksNZRJPw7vs?@`VEa`u%59quolqYu zOB4`}MFInk1941fHe~Ne{lq+dLQJ>yGD1SH=+~OY3e5q)v{_0=?b4c5qi6@6Cl@93 z0y1;udQD==3{!AO-l_H_URF*+k8Jf~0}kPqDp;3nG&PMwHio($9L#Xk-(FRXaiKkc z_x6AsLH$E2)T6&=@*R-bH*&7-Pz}8!4?;WG-i!izNV*FJXn$Zg*&2uH8BJ+zNei+5 z0Eh))6PS=c=kNiFdUvz0yLx04ranX~{S^K5w}GVX@b`kYL~tqq;OHi11(BB7zaGWN zuUhtQ8a-+Tb0Zs?Oy8mKsR2||!ROgs(1Wm;E}o2+fV?|Ez-P(>?Go}2tlN5b+=upH4tHa7AwKWqBiC9d87h0dvgxzX| zePQjJhjge5oq@|YtA%h!gF(BrAEi?zbUQ_7SGYlRBDaKIvA$y0c5sQyyVNZq8$Z;9hG<|@uAng&;huoheHE8N0iGuUOyCnNzW&Jv69);+EoXXR zLfG4`ZjJDFume+4EWGpC8HiThb~v>ro6|`s1xV;0T3J`?az;%MrvvCfo#f5rypZ_y zi3}9ZY94?!Gwgw4hv#XV1GwsNF7uMspp)a8+o3@?I0jC&CS|Q-zHb?HnS|#z3ON=H zbTKx~-yb3Gu50BuGz)zbTk5sa>V+qM&v8Bm&#l2i&-RTdmI1}(p@CfF`*;;|>s^(D zNa{=;4#;_vyhEA~?Xok8BcM>#IQT%xN0a^-KMT|n;7*wE@bZuGsYd@i@UYyPE5O9a z%md=D4xY3;oZbODIuCz(D5Q{R90@lai-3tFr~_8cC+l7Ytm@LM1B(Mp_Tcgezr_RU z@wSTl`%lIb#k(2jBRm&gg)n;Ub!kQPK^R&w`5Toq0y>We-qGh84~!`9McDK=XT_C@ z>=ipRl1uM2Yr%G%8R9w1N5huI864*^+gf$V)rJTO=F6=%Wj1Zy9D6|1~v(JXCm2G`RcJ|x>U=5vgOc%4;;eVKJOZa}Z+kAK@xkiKf@lfN4*{A(90 zTU7Jz*>*Y1aK^DY!pHDyf(@5p&(^E%7lTaOn6wdP9)@4*e)}(9Uvf|(T!>vHnlh8{ z;C+oos0*hWZ&6q&m8?r4wqk*gGG}pqYZu~tMhp|Y?5F?4k z9}W322&6|7?XqpM(Gerl=pyg5KTbtXj&(5VECkwOR#9&e??_S%Rj;Bdq<6u_*~s^aF`^AFnhcOF3xtev4^W$F*B4b=^`=?%3#bl`C=HEKwv#Y23bU zYLjxmD*0|?gljK?27Q&iC|H4hyrrk+Txp1$tMg{R0s-e#Vvr0$1V`XC_K#aO-Z5FX5J&i(Se<-Agl6p>01 z>KYWF$hCLV_0`!9gBb1vxz$W|R|>IR2KZXIzP+;q_kdEB{Wzt=L&b|c`aWCohIlgc7wpz>zxutDx@TY|4Jeb0Rs0r%#XyDy_ecPn41i+O@gd<6R zLy(HQxC@XJiPW$u37g}WeMx~ z`>=-PGuUPqv8yKO=Uoq^S~1V@nFbZH;B30(vM|`d&65^0?~!X~(6ySw{bx|EhQ~f3 z#aG&6EYWtWUpg*^p^-=Ap@dUvO0OLOm7l!@X#P-w%k5D{Tt~>X$W{IRvg$JRBm3XU zLrk6#r=tV8Iri`8GUt(IXsPqe(^<(uV7OWZa`W*4Zw_kX=4@# z_EXf0r~tPK#ue(J9G>}$^B$2lA;LJpx}VSB>57Gjh)lpW?h-(FuMFM$R)y~UMlxr= zz1Jzby-75l#)2}bIG1@_Os~Qh=XEaIQnxuIoNSalCONYlP>);ziIb(qcp_)#LVt~? zQNjxo(z^2<5fyost`DnxUayQj7o96x7JkCRep!e`{Ek`^r%LK<*=ld4PPme%&rfLK z&A_^QSwCBJc}k4pnF6^*Q%4;3#KzOy3l`FP!&%jBv70Fgl{c5$)^2-_rVN_+P7K~= zLYtyoh{&aKTKFfLv@K_HSMnrxYiEYiH)(SD1Wrd}49mJDP6wvJ1rWpdQC<#-?|$0r zFrtNsQR-~MO=<1h?-?9W#^TXCB&jhsexKn_LM$i+?|tKtzM=G7VT9{jVHm)w{~%yK z;3VskxmVvBB~y7M5#3?JI3HZ^dbbEv6s4#fgJY{&*QoNCpIA`dGbGw?iu3C_vcry* za{8f|*@`7GC#J2VnX`yX;D-l&sj69+{T?+ze%xn&&;mN=}7i%f9r!Qc)pe zmR#!hR|#pYquWIYoe}+KPcfVvNk`#O{HI*?BKKlTy$Nr z7pGykieuZAz-`L1Zq*0U0Rk3ExXXww&2_Vdvp_><%YZ^| z?Ri)U({7o|<#$ibj;KD6=%JTu(PupRD~~Xo7ySt=Cqthx1BcMxfZxnIee9m_nTLLF z-fH}jKg(mt(R5Up+|LvK&0TbSaWV)9DLpwx_%AbXj`{xuut4!SNWUJGfa@9!wXi73 zrS{5}+eiBL40#TXHK@4M6bNaCOZYd%4DHRsyh^&#ehcy?KVE?wi^n^5Gnb<35~Nos z#%LZtn{c}!y^)fZCkRUWX55p%e{V@htD@Fxn=>I?%m1$G2dQm#=_Qn|*OtI8hKN&w zzj%T!)mNui(B`KY<7_cmrbXT8A2dr}Ym36SW1oO<|gn$kq zXiE;6e|20><(zLXczVR{(utDsKl}NX(8WFy6J8Wx8;_~(eNgzm#NqV!tyG>YSy7dE z^hk1qpW+q63J2qIPBUUV3dcZr;i9eC3!{-Rclzn!P(N%zIM^Z%Tf;8>FZ} zLRPZN37Q$hyc!;02c%4;IYG*YQu$wsA!VVHL*#5;HOyQIbKoqNsf5o{ZZ2KY&8>cU z!DZN7Z|bs4()E}2Ir>B&RYbDN+@Ff`iB&VFdT{E1%Dh?bTuS{h8`5DCohhIvko2m> z@Sc9WaFfbiW0bHq;TG#GeZI@&xGu_~X=JxCjnt$>-O+(27Gd6yoUzIxbvfv>!bO87_Ws)KJ6>m#?rBu;_tW*WVA1@iXTBi3(=L_ihDD5A>`iJ9 zA?WP)t+^3eK*Nv}G^RUCqTJAUQ^y?g@u5ajpGOTm>m19)JRfo=rHtS*Moq%C=GANo z*{?dc?vywXfj}?d2RjNDx;K#T*id}sCK-1jy&h@nx8!xA> z5i$^Ol|b1qDRgt>9l;!?i9Kgkov2Y7kY*C^Jq=mj0AR~wv~C;4ndLc1KMvd;!}XB# zHXk_6V~~p(4`&DRHkKNiq$&_kO=?s-cj6OYF9XStv$b;}esgqguFJ z)0VJFWPQs>TyY%kx^j&VN$rGAN^pZVay{MrrXlc3kWrv=ytaVky`uGnexZV2A8mGw zw09o8E4ui~La|OnGWl&wz@^ofK<0p}+t#Qx_ojcn$qXb=3q=CR!9$&t#*F4P{!Xpg zx-AFD%mrK)jW+n^@+0m&mfOTi^QR_TS&weWTC=;`7av}mlB04|TUGZ`@%2J^EB)+g zn~MzA@PjxXLzAD3EqTz4`1l;iJN9i=)bsXAT3p88J{OS1@i&v%5J*5jR9xT2mFk~o z3c%XdU>q^ccYQ~=aL6XwU37>oOiWSe%>WGE0GzaAGFel@)^6n|FHqN_LP@Nh6)yrv z#OyJjNm|*JCRta~xQi5!?+JlI8k#!n3slwGsxfkts#OZLz%oD$$QUX(^df$(U%UhT zW4Qc#-#w@|Re+Jl6@K*&A*%Fyjg@?IgC;iO#FLb;;Ip-401e@Sae7^p7_&@kZDpZH zu0Uq`gML*hWm>^jobR$yO2Qls#d0yi8+ky2Sd-v^So=Hkv~Q#j^T(DC64Efhxo8F! zLxn_mEbp;X5N~iJf){nv7Tmre2JlbPt@}oy=dNHR@|({uo)*JQl+RMA(DheVPx9E-iiD6|gEVr1=894%AD>?&v{Az4_ziLaT<-R$tn1 zwf$B+33)ee*$Ma1IIF|ex6sozVq_ZGsz^XIQxB*SRl!Y|5jwjuGl?LX-=!CT+LS*5 z%)F`uSK;Ml1>EGhvc0<{mOeZ^@%OF~8)R^MOs_5}VTQZN7N{1}=>cPr%YVFl7Uelo z@N3>a$GZ5haBu2qyxA(l79aTHfu6z8U2C>WVIEs>v&o5Z1kSq-OalcTuMv0a<@z;I zy;*!hIneSUMPJ{>acxYQUKq~c53LMtP&HC^LdK!<9NsMl4uO0ACv^N9OO~`ZJ@B|c zR&wNB|6xS?^Y9-|a8O_VQQX05`iPBCBes)K@i-72GN0^Cf8cos_GC4$p{1X{wl@}{ z5Q1SE0)mO=amg_EgO|7VwCS)TJ?_MD$-x@n%=5p7pPAi zd&;`{I)>|a?lQBsNq=fee90PyTQv?c$c>B#R=LknbbOq+uoS*ch8tHjxajq<4YwOw zU?J|&;l+Iz9_>CFIfrkONR611SVMLa#=i9kaH8mTQ-l&o_?eOJKJkFF7t-&kXza%* z8LlQYyK@)0^RCdiR=1oVu>LLGGUf^vV8f{o|9c8H>#E=tISRuDvc)L z+p$XVL&;tQ+!g5o!eQ03irJsfMe?Iv1&}U&g(D`0@v%=X#D5%m(Ef=TpukjQbH5sl z5rVF~#H9obt*i==M_QzIS5bpl&CP_hO7i^`5f>RC$sx=9aO|OuH9dZ_ix8Qo3v}cd z1Ppxy%RMVf+GFUHsmm+?(MQHF?2P4y#Fawe8226{2pRk^qtwKBY9<18vZ0Q-^!_Jz znkTMZTiuFX6dx>d@tBOZN}Ai!R;PQzFB+EYM!^!Uk$G(nsN9LSUfGZ?Z-WNzZih+4 zV_Xds`3}L%hKkm-rHwLsYR9T%SX%a^y2H>ichi>c)KWS*#f3}R!+8-Npu-O#m zF2p;mD9j~1qDbcRmK|W~yOdF;4OQAtFrSxrHD>exe>tuOY+OajTkVRnt@SZwh}Aw^ zqO@?HAV;0ZYus@?m_NnLVY0MHpkWA`u{%yge+!U5A(BC_L^;`;l&Eg>@p0hykC%To zcN`g6Tn)V1Le%Z}j_*8*h6^fsJip1u2*0_+76cWPXV@t&4#ZaSn~;FwKZ zxfuwZlm7TO2Rx|iD*YjpbCOeWr6(Gdw&*1o4N76#FfuKD^|>h2pwhKxwmINFv?t}5 zt6GOkns*k4oSQO|X7fm66R%=~Ja}*gBQ8$g)Qh-O-WQNMO{tOMgR0rYlvNz3mPgU= zmlCfV%Jd z?q|rm;juNiTfzWshl`x7J!2qS<&9%X|JO+n*J*J)K^WH>pV9Rb*Z;n-|C0udnK*=i zj_;qc<79nwGAF{h{!#d$LPO4;Op8a0g@2oOn*~1{7VihT!1ee4r2Uf|2|~w-)i;Tn_A5ayT&qtBrr${zu+bQp2UzBV|{C2RG&xl-{=!L9YJiY+;8mj_!6q zsamok2JUfly5KxYWY{S4!Z4U;nw<8IrLt?!?NsB0_#3>dI=b?5}Gi-*lvh8 z^*tbVGrrBu8bF~O1pG!U$-Qfw=bC-?v9=_omos)UxEX*6yK15P5OBFl_3 z$@ftY%ky3hm&q>p`Ju|l%CfU9zoY>GoHwsFf^~s>8lN$IdB_K`CKC;A$wEjnJi#;v zb=Q#IE4ro;7Nvw@G#C-QqJOy(v7BQ;kfNSJ+9}uY#ka9TyYcI?y3+%{n>b78V15aY13>dH>x`hb$u@837)hE%oQxbf0GHX5wB zvB`@HPaVeBR_>t}2@NKXz8$!Hcf!vZMd2O9g7?fVViF$Y^WX79 zxFe9#Q3eih{m@%b3XkfL`@tfYnzXCi!m9`bbFT@}@+VodmosW_FM?R0Wy@TsY8g0! z0fO~|lJ{NE;O1j&ntd0fifH}V>3TXTF#P$O`nBoT*>)&ul5^R;)MO>R|5-QlfB$*< z8x%L>>jkI z2hh|vi}$-~2bF2&Z$N#nd^nr!HAX>#W^!MLB$Lzsy{X+ z@C|d6`t2*U7<5U*g7O;W+6U?FLZz{ zyHeGoIHhbs?PvMapv`HFsB@2J0x0$Cb(NPU`o?QHXw8|}u#rt+~G;S{x3%!J2mB}+(K-T7i&SSkag(veoPcq}u_pU@F@3&Y=a^Fn3 z3F_~7;1t9U`>t-Z1DHx&X0Nd%pnY#-yfw#71@PU|WWmyQstQ-7Ohul9dp~Z#P8HcodB;8= zbE2(!|L%kC>odz0*iZLB&KLRa!C*DqNFVbo_pYrcm+%;5o=1m9Y4p36GNco4ev8q3 zE%NmN8sF9%->M|taZoc6TZ@pP0MULKH$Nj~ODo~o9qzTM1R`pW6)`c5D!{;fgju~D z(E;tI>S&O1HWF#k!QHP{MFQ$Fzj#Rpl+x>P&m%bt)c)24M{mxlq5^E9{OP2UG!;bq zGfO1Ctt@Jxi+!;Kz%l(n=x1IT{K9wQ5j;kKu`jaiy(= z6*JyV3-kR&U!5sHpmv@-lVC=mTU;dJK&_=sOGTB#BVmpN`T8*Am(5W~3l+)kHC5 z$xRe-_MHRo`B6_W3tp}Xy0(-#QFOCz&vX|}cY*cSpb2G8@xs<>K58A2$;Z=Qy07X^ zc!3Yah~Z)J?`_=TcDm5Eq)?KrKntDo;Dr^-3%R#n32iZw@_PEP21UHw zmmuK5SiKXvok9-(|TpNsIDUy?x3G2>~11<7rC?&3+;ePbcctjk^@AZ~ZOmT>H7kTElDu#grL+cs%jCyn zc&rDI1yd~2yKtuI!Z$%^BcG3W7B;e=WKCE>;3H)WV4-wFq;IaZ+|RntGCFRqJtMyD#q0m`2&(T@!;z+6wXRZ9QK`~b`S6@y_sDQs@BTVt{btp9m8S|J5Co@a|vD;1Q1 zOOyjFK64-*ru>DNduTy&2gF&K9GJq?3k!KP8?fx59~3P~Gg{rJd*M2Yv4-cozrTNK z+T24f84=3wtZbu?jtz?HSvG)*B$x~^Gb)p_hsq&nBm`*i|0DT7mU;D$=KkG72LDTE z`Io=+R0{SzU#uOQiBW;hm+fD3()Tx3Ju+>Es6s|h_vQT3_-H*(`$jyysYD{?LE0a4+v`pP_Wm>KM^wC>iaaGc)8ZG;5?pin=doLfcY~C7 ze?r@!g$qDGz+sZTUh`;1Z5V@FaDc^sF1_(pwgb~X77$EpKd3!uXt6AY>DdQB=ck^W z24pBNEVDE*o=%3Tbs(@EtNZT|FVtxX30FXz6$GyEIUiV4U> z?jz9af>3=BrzXMUEuAZP1HX^SV~^Htx9!-YD_Q%7MS&U125j@ryA zzG6jiET=*CLLF@8YbQVZhT}@-!@1odb%}*EC#iBiDRPw~q*Pz7-qgMz*`z=$)TSKr zLWN)6{E||W5cKqoF3%w$q;biy7l>ZH0s@W)#2??F>SAKHVbY|J_wB;&L|ix)`YrHT znd~S#L&)wzx`ECQ-6K>$$Y%O?A^RYnQ&AD66&NRj`eZ5YNsgPYKUfCk&-$8Yq-DlgEG z)D}$dspqTQ6--(YD4i98K&L)Ch-mb5h`i8UbHfEwOQa>Mj7a)`3@f5UT4PQvaKerM z+uM{(<0#NPaQfU11^$2w;05Wlr=A=#^H>)kq(6nWWkb*OqKZBd9>Zu+o=H9>3;kh` zMkBV>x^9>>73Y=SdO)q^6hKJ>d@tcGPjV%4$YVb`}5Tt3=*LZ~{gJ(+y77W^|; z2MFV+I1CW&bAGC&LbK#y2z)aQyy*EE=qXVsy6#K-=VfHpjO(Xy-F4w z)^=3qgjXislw=9GDuu68x~_yDFsf5<4=*H7`ZV8TIY>agoJWXtSebBO#SMJ5OwK+MTD?Hm z|3k{)DoU!AE6<{Cg@kWpr+_nL-uMnOFOF zkyzO__qIt+uT6@=;u%?aLyM3bF2HsGoWLZF7zsDLt@H_*r*EB?w<`yp6BoJ{j43QJ zX}kJ!^RxT1PJv2Ggb7j}d7-`P#wI;n+Hx{is|E%YY z|BCM%s>3grY`8zuDI2^icOF`r2~uu1DIa&}{|t7Ja@J7lN%8pw95n`O$;j)z0D@Io z;oGU?d{?CZ|KU$x?EY}4M+md$c$(Fw)fny!)EI6XW|#cwZx2L7_cR~7t3?Jz==1;C zPrA*1NSOjsgW5{W${P-4eG#GtN2WVv^KQw>0>sAHD6=XSj|L8YAgZlZvemPchuyr8ycbeJhgZif@wNO$^T z#jT8FYR5x!Y;nh6JjXaa`@`E{&0VP7tU-hiBspy!_#F z>;M=k4LY7P(YL&dH6k+`0B0{M+raD(k5%*7#AAfyLpNglm~2sOqszDw5=X;@@A>-s zpMqmn`=pcR;T|Jh@sC5?5H65`4AKf(Ryy{^1-;kqZ3rc=tiNTmLJ|XYBdof5oYtb@ zhn%UB)2V}6eEQK-8z#2Q%%co;p@ZRck;=g0j(yBNt_<7s*Z-TvzzrbfLT&4_^DVb$ zAN);@VuZF%F`OmND^#V&RatFo7%Bz-SrPeBH6j1@^S~LsSEBVbM!bLTO#^R;_L7Xv zmnA%V)|+vnqOt`lD!AmSyZaPO9e(%&aRw>7vsh%pDn6FqGf23T7#c&SV`)eM}qzYL93S1cJ#0}@Ud#E&> z^1R5xBU;!v7R)Hzopfb3Fl3qLby3In$(4%(x(Mw*uXYYT+y7*Pd(2a-^oG(o0P~pXRwrMSlTF@RQ)q|q4r>pUo ztDY0ctkMtE`gb`wC4R|ew!4KLZ3DJiu~h}pwUUz2#uzK6D zDI4QACX2Z8V&%AyyXF={XbL+esv6Hh1-Cg@_GZKm-?ri}w z#&tu$nip5r$0g$XwgyZ$1sVTmfbn+YsbtaVoq-c;-_*b z8~T=!B4)?T$}^-Nk<7+M{?`mnRB{(o>v<1WssDww(%XM5q~!l=&<~fH|2@z<0yEu= z#0lr;*@KE#sGbQQG5)`^06bZ~{=dJx{4YU2SiUuUXB1t1Ex}BsrFK+V|5M)oAyfYs zC`0v6N8!Io)xfJdN)6xjaT`5B{%I#d%%8TzpC#&_z5>^G(Y~e4w#w02pudL(&RK`x zJ~9!)yq(&k;tA}pMDL8Xl{?tsPELQodabRY2W7qe=YS=_EXHlY%XS&q--(O$Sb}iu zPs1vuHa{f%#-=VCz~=_?m)az5YLg70&q^zlxpgZ>_v6jQd2Q1%wRz$@Xj;GwDiDBE3XBRD#aHme{u8_~`3VScYBVtJ%eaBjbT>K-;v5 z#p!`F?zL02zzptaYY5xi{#DHBx2KEqO3t+JmEv2xUoFA|$t)k7leH_QOks?fEplGy zGZ8v&x`H0kYn|WwbiehRSLKeoVxpbFre&0bH1k&m{?!RxsWN+Rkh(Fl*+MAMmy{H? zMH$DxR-Ig*M(Pk>R=9FGqm@)F<^JT|{%_4%aqv^$?e0Vs&SjQG*jW=JBSYn&l>ylt z;71ZScELfj_)wvG%`pcoevGmsg2Q~A9MqCMo=zOy%@d+AlTA}mwh=7T`WZVT`o&iD z5-9REG9r|f0vp)@4s3pivJa@o%O(UHN8_trYV1m!p{}_jT?>bKC#|@G@V=Wx32}%> zeLWYAZ_66(smhpRegkB68>va1=T}CqZ-{arfpu1s^!~_6QA{gJcF(BE{6EJ&Gnh9n=s4|?G`TcqX?7H?G=kL&AGopGy4x62!#ox4U|ZXh8h z-p-D{t#2UkNhwP_f&$dlo7;ttE3of0Wkl!DaW zIlEkCg;xp+jvO)FYzb-nnE)0_Z9~ILOEL^GQOJZv=qqPFFX}Keg{=gKHR?-Z_;`S^dcyn=P3=e^QwJ8 zdK5?0=U$miEafV>75=g|SjpnjTjJ;sFlCD=AxlOPMjD8WTUpGAuTI%!H{#QedrvcJ!eL@}NNre@ zgXjShxoGLia)s!AU~^h)*1cb>Z0$jy>yn zeA6QZaaYsM{5A9c%YW63q*wEhaK3CHjj`29O#c-wTe_3%BcvbP1FUX0KP#cY-sv;d z)q-)(4vEmGAF#_FA|6H70LywG)@>PK#iJxDyccy~J}pK4t&+7V$*lQo zhj-^hE}#1;eDm}Jkom3Ig7{%r%WE1-XAQ+Js*-lFa|pX-X)AX%`(BBR%0$nu2(ag- znCiMKy#5bBGI*y-_6qWh3O3CI@*nChB*rAgaXRZ#3CIz&;CFq25?DH&EB0rVcbmkA zrXGHhsMP@eZ%T_Cy$czoFJ2ClePYZ( zyXrQ8KMcbZ5JKu_PG@E}q{9d-duZ5DV3v>`L|%a(IVjqQr<=pPzrX|!%34Auk*OuYobjEfx^=KQVXiR||TJe%!&Zb@?Q3shHl8X)( z(}$-GL$fOt{FErm@bcIlb!}!Ycozz{bIAEDS`fp+HTrpnIQT%ndjs-`k+|W=;TC$H zd&lDGC$tIdCL@PkSI?%S=3PngYtu-pfu~I;o_^s9Fov%?-~S0|f3b|%NKW?eq)@NB zNXEFTo^-$6(nGA&dqs(#T2&}j>wUylGH3|?IN0xw~rOuuMuLSSS z5T(?|VJ2wxiZpi$&|7xgsLu65ys;nLCh(@*=v$$7C1>20*ue72V*cyb)IYDLkY zd}G){(~CeHcyW`Z{L!V^uj?HU+Tz^nk^$C2k)rNNVMXSWX^*^gV=&_N&Hoy*znk{~ z-+ZY64*GJe%zJ!NIt2m+gMmF=0trX2UxiN^JW)1#iRAv6iMHMT1r?_q#?s7P!+?WA z>837W-zSM}V7v8W={MazEFOqO!5qoL6FonRND?pr;@8KQ1!r?_))S~Z2xx77t6VOv zQ?AsCZvnnh*De9zpc(&g`>EJtJkSgEPkgV^ANdi1UL?xt5^Cp+k_Y+w_m<+@1k>Q# z`1_066JuC-H2X%FJ%1a?>s6&KxHiYV_n*7${3<=T6k55YH6&Ij*R#3hwX(oDxlr7} zC*$AygJRC@nH}&J(cyO24K|StxqWO*h)KUtrif2f=eoa-0i?ET=f_L4l$SBCtE|$D zY$8rk1?kQN7dY%9ut1AAX}jU{MiBuK6`fnlL=Nm_%yhCs?Sz5bOkzD=Y!dp}QhjM4 zP=zX-E`sbV_sze*F=N1CE2mfI#^n5yY@n7xZ~J5ESvC=^(?trfi!bTll8EgKNH|_K z9-!3fA?;5uwQ+CNC#OPl!NPmOuho;)w|0LB&=RD~i90wxZTX#6dGZut?K~KEQHGYX zjP;iKD+tiyar|O|1m(UMCIdDzZ2XsmkDi7CcPij~ryEasLx81J8Ebt{o(V`>X3_V8 zDsbm_bOG-bWv(*Ybw~Ok0ezqABqnaowM9aP`1DklqJK$#s<%{KyKagtoi(jcilow;nbbGav+GTy`K{)K5hd$x*%O; zOxYV0#>@+fAo+zIh|XIp@U=e?72En*p@XDRG;nPy2H#rna|d z+A)RC;R%n??3nH({SbUgr8wJ{-YbZs?^Z;Dciv z8@RWWfi)-~o4{aHv`D$e(!?9P7z&EGq18~Vh0nRg4A%e+fjj2jd$(MNZh4!2)n%c4 zCM-}g?}PQg%;P>Nb~qcFgLFnJzMyH{@P;tXaPZ4!0tsAK#QEDs0Ch~eh}7j)O#P<$VN{==|;FL)7-yHJY+MwTx5) z8dARAe!Q|179d>5ua<8mDt#7XWfR`RGuffFXj)l_6$%#Ajl%vLA^}G|`{zlE$IxEu zSageV2>Wg3XOrxsI2Hflje7xn$lY<)_}mDst1>q>}?sPB-~5z{npu#<)&97TfmO#!nI0tnXPs+x?mX4FDIbfMf|v^`^L5!N4JluC-7u5z*}m zr8Dg=nn4OHa^MX7Ai-0I?l5X;mvG>T>3l{i5gre`7PX3XvEa;SDry5&#)W)iw^0oRT#eFr`WCF7~;B_ob;s!CjT$iuqA6#*J1MFvXrZx zknZkOAuoye*vy|KA5Qpfr<+Z{@zBYD{cVI13vQbnMJj; zad-OB>nY_Cz%`H1^3se^sbf4w`p+4V@!U*QN+TVhjkEKi%Fb7F#(B!~p~A}R#ilF0 zV~riR2R8kSO5l9=$co=AAnveyMROVhqY1~Cv@V{E5`@772PwiFs{3F3NwvE?*QT`2 zAbG8COq12W<2byo0>_IWjiZORq)+t*RUOE_^ju)bG7 zg&)ixeX;7DU*I|F3+!NdO`<}GnAyJ8JTpH65e3A!sj(8bitC$b^m`S@AyNA0g^dE| zEr=&h3Ghm5h{OW3vPyRkBq6%Y$=Ho@qw1+)^gx>rMda7xEJVJ0!)64lK|DJ3 zrsn4nf?M{y5NsHeJbkVHvl;1PEai6lG4LEIqmdOj=REG?JMf!&g~yQIFD*T^d-;mc z_HzW`v$!KJ*u^KzVieox@fhHrj)e1z4|r1f5=1oJb-zoXZOp-CHL+ucX_ zR9&L0j@9r#*n9IpD8IIGe3Vjzd?ZPdC8Q9A8qs2DVW=1qLn+BJCNlP|M3S`F%7pA0 zYr-a|L6AQUe z^*4bJt510EcOZ3@#=R$%KnaqkeUrY=0%8UJ(?2C6btqE}%OLZhJ)!}cb6G{V?`wKX z>%Fn<;>EZ%MBpp3!mxjkA1QgB6X{50!>!^NJb@dXt1yZDi+Gju$L9g{$Z4kX?UHfF zdz^Dhe`QgZ*>{?Np2zUMCw+O^dX2b={2}fKu;?-QF7%jLd3sED{VG&yL7uB5bGyvr zV_&MO8?g+SX{R;sur-gsJqTkz-HM{3kfPVBw{O675o?r9jb{-w1!@&j#$e&q)g=^z z2yogPG~F|L3%JI*oDNw90y_U@FlW)sXDI1KRoLv6&|s5kR~oWys`KEgRAba9&iJHo z#vnungkCyyjlY!P3I9$LN<$4GfM>q&O8nVsT+8H*e8c?i7vBw=oQxiursBdvRa59lk;cC~^ipP62&`k$ z`srPI?8CcnZXLZ#_-eX}-gU8W%4k<-SErTqnI&FGn0EA}3v4%1ij_XfjIVHv4L~ zZ0fle&h2TQJhkD|=^y{wOb$9k-0MwmVV%q7Fd9=zTqQ!4fKIdndMwuQaoedM@C5gy zdq309EP<+1g_BzN;Eg|6onD>!Copx+_ zBVnUz7*75avNH&O{P9@@&>1pEECY3ym&M+nRD%C_jlc4uWr_1oN8zO2eco`8r(!WX zPU9mW8d7EU~Is$b{JZeY- z=m%$mFTaYW>jl*`2dhpOPl71Lt$UbOp2$S1qstf5MeO}G1D>hh-HUMzH+wPmp_9+Z z(d>m7{l~j2S`<3HyMExVtkZ^g*#b-oalAa*jhEk2r@|bprRL04;Q>zuGt^kDY1Od_ zH9J?v0gT!kldWuogkBIl^?fFp3wICZN;tGl!V!*HLpB;SUj1DGw*_(#Ej=Nn% zxfm0R!m5!$Jm+&rTpkChP0KRfWdkOwy0lop8VVkEbX+?Mgyi|I=mrnT+49jNyL z=*SAhG;=ATWr5E5HvKQ(JxOn1Y_yMf%oN(mzxK)DD{tho_hKdHEd z49-~@=FT2h%<{g~)CSP${jj+fKj#nWis|~MiM%7i9~%LMt*wEL;H5g# z@c{a{{9%PSYF?)papB{aFJJU`zCn-K&QjwD=N@}6fS5jj@tdzwHHQ`UR&xZJ+-o~g z6`MVjR*{LI1?)bC;7vZAUcCodbl8a0iKtJWz2d0kn-bLg_e4#p!inOY&&Wx)!bCZ@ zw4Bz8ue)ucam~?m$gu$!GG}4Qj8km zBzlYtZ0ZZ)=^ViF3Z>dKo#D&8pdMfDN-(PqLVAc}3~-$Yr;Q08sxzKKTKDD5ze!Ck zmrT2kLh58^ZYB#NbO;Q5kW?Qu{9~m%G^wr6Tv9|k&7yq6<)9!%hscc>tf>+eJ2=k2 zVMQ$m{9|RKebCmxiaYsS#K=d+8A|Wj;*l;imrW*B;s}Y$ykq<)-l323m8^eb6FGd+ zzZxs={8v^ZY9VLkK`Fx@AKM)NvdzMJlmM6Bx+N+1;HkUBOBxq|QsA4iZ*Ud4KuZGW zb3IIbg!bh-oAtdn!HE9g)3;6ADyt@T;bfPorw<`tChUU9N4Rl^Ejh+BNRzSX@OU=k zSqyMUHYr;qk$zZGl%sdDZyG17zWrFsfAXp2^#u1DpnPbK_}u;d*b3Aok^1ToSH~AQ z#@ld0`eemA=~nft<{gmnp?ALDE#Ei|qzt~4>QH^`T>*4KAt*G-1SK?7vl%GhdbFFV zZYuSirZ{j`PZ+Gs53 zlN?!=QIs0^gdxv{dyh*^TiZW9T)?CY4#T-mRP>PXx=;cicjtfkrb+Q-w z_##s#BU{HCv>Yj0apr(gjfUSW*JA&$l_)*a;bC&-yTED@Tb7w3xdL9tDVL0W-k3KQA(oSG zdMEoUS-6kUYv*?H#_wZj|2^El`4dD!y(g*t7lzU6bI@_qsnBBg+C@CO>)@>3JrS9x zwl**0U`?CWF|!LVVrfrm4@W9Tj^!jE6Iw2ZZx5Nt!qI7oSiabAk-8ye(m_wY|?l`F%;7Kg4q4cykm;* zGZENGM*zBo^;XJct!^4(S%;cVp9 zUZnP6o)f1~oECxcaJR3aqv7*k`;zUN!G_(ea5cgY87yGGzu~yRR3}2?4j#$L*K+uC znnh9(;EpZoM_pzUmcB|@w7#6sS^W0Q6pnFFvPjuyh}fYwCS=k_WawrM!_hiy7O;W^(^Q+$>Q$86-G{IEH}6l$t3cfMPA~<`)pwu0 ze-*BloT{@3TR7C?Q>A?K@*Cy~an48rgKmHo$~ic>2pGFpEaVU?Zh2>2>*)<&bP0%4 zL$d~64%VG!(~5i<2BOxt^1ly~f3#2hc9H(W#A|GSp=DdY4z$cx0?w|aqz04+G5+4? z@8-~mds|w++lC$b79JzQ%f5kRd)pPe?sw%uRQ9jHxr>eRliX}Nf7=lBJqSS3Z4dR^ zv8uiSRhXH49jA=hZPdJ~`w4_x1ESDzDu_e9{6k}*I!yEl*v7B1Q7k$ai?3=CDu-#E z!?R9dHa|TB3~4ryR9*In_JyN(2;>&^yA)-t>c_<*W@FPdJ8KUk--J~QPL%yve(Sz# zU;7nZcNUAU>UBnkk6U*z=|KYL8>Ur_YzLB=tZ-{sb;P+Cxw;G^8)^64E0l-Oz15dh zw31~ype(D06!=J0wKCU)3hS;9b*pxj3ocp>p!!T_RdpFKj<+&)DoHSZmihsTb7L|o z%$@nzZ&tF*M%=4&1MB0&!q_4wVOa4U=W!(0Xq zvV^6_voXM$RnOP73I<>X(mQnAaiKzXf@9Qa?1C&$tm4a zu-Cf?zB=G@q8+(l0k3sox7?SQlKEBOeZDg3_<1>Q_aP5)^7;MMA$GmA-v9KL+Dj4H z#i_dPtX24{Xx-g%G>=Bmm*lFHa2@=nzg0NT%An17VF0C3?Q-97rt)R}@T#f6NGZFT zG#jwgHvPfDRJ)Ps^Ct4_8t)jvl{izwJ~Amjv>%Ae|Y!A6Wt41g^J78qCoR&)<{cFpjn) zI|tJzoy_AND-OHv`i+`KiJf9w+La`D{vw`qg&cdpmhjy1PQ3|>vmIRGbL3=0N@4JiN$n;x-m-0jjevhb{aNEpZoeyk7u(jjg(pKSJ zTnJDm%NSI682KJ&r)Ws>7Y;|y*4%1Urr!Qx7QNITIxt!1X*!^8=w+%L>I&M~RK*ay zDjpcXze7mrz?SuUNvhhx$>R3@Ffla=?IhBGSYM3d3Ye5YobveretY)3{il1kB?UL_ z6c=!${s0tY!d|wR7UT_Q$??`pZV3RY9Py0}piR@HE|9gr0(`>9AJu(v!K1d4Y@JVT8>R3 zZ$~Ugp3RxDjWZ{g-KK=D9UIRX`P)3aE9;Qh1hwzTXAR~knl!_uXaBI_0#djYP-^J; z{-Qmy-;e@#iVn;Wx38~{nbp0Ub<1JKAlG+iEc;KxUgg@TI*qTvJ7s!S3uTngj}_j# z8d%8ez{fYxO7V{Zq6 z&650`Ad5dj%6Q`{6K#bkf9eY#K&9f}HbRvkNU8sU;(v32|Ad~VfkRp|4+yrvqqrO(0m8}C|Bau;A4h;G z3opyM#*(T#GO-rL{{({nWP$%j@c(=p{2#$X-eKQW271uaR^NJ97b?mjRIt#egK+J3 zaT0>^=-NTeh~+?@>Vkr=BV|wr%I8Dvd6FQ^YqVR=cGN|q^%I@%eb5ADF>t7-U}mx4 z#d4;=coC?9(o^a>FtwaWP#?O)D&8TRy>utalJ8{kG+@EDqj8IiO{Tc1{cg@>%axqd z`w#}bx4AwJhi5p#*2lF(EL9XNjRjk9PP|N;sPJ=J7^Y=!*vK}R2gGDOI=w(p2ka=w z<e( zJ5}t+3ZxJH&S|K}iz%Dc8!4e&v>sFzi;HV%dTBqH@nPm^(E+F?wZEZ#sZ%>(EG?i` z{mZ0x!vV4j+_KF4GPheZ6ZKiHTsn|jwDeJ9ezJ$4@GTrX*z)PE!hE=}330A_02Q5P1ZH$+m?g+w)(^+MA{)8tlZK=Ubo6g%LXVpqhKYK;!QU@H^x76 z2owt^fW!={?9#36S;LDTFdX4@AMU(l3FIMtEtuE=deH7z2VQIMOTXsn#4FJC^+xR+}`6}Tht^EtMS{UtD~1WWDuw?Wwq`I(zdhv1L3g4iWSeb zk{`ZiBKNq*<6UcviM`uQ)wacR3l2x75pRaV4n7X*#(N|k6iF~oK<5Zyy;E<7*06<0 zK3udYJA%;jl)oGlmIXf?dI>wp!*7ZXmVh-x8Cx`VCRsW_YkZ2`KPzt=a$iOYRC{u| zVa^tkoIFgxo&v$=j^B>RZRgq?0y0HXMbP%=(pj8Buoqql-^B2Me1eJ={Cho~9JTu1 zHfN1`?7DXqMQkBK+-IAyV?ya?nN;_<-NN|>o&5B$ZeX@J#~>|r(3b64tl2Ie*teTA z=l0o~AF_y~!s%W)WM33S`F1k%U-KXc z$@ICtXNq8{@JuynEhhy(@nJ68z_j;E!UO)Um zUUx#e3&k7aD?cb@FYr!JKqjgYxxYqeFfCXr0r~M57yV|~@TQ7Onxxbr>$^Nr*Ln*D z-Fr7xTx>+fA#So0&uW0+iI6v3Xw>xK80JrS+g&d>$#z0S$=Cc7uvhYzGcOK0ylr8M zOGMnahP|segTd*9MLQE>5Mxb(%u25YHrcnn?no|DjFZ?&Or+ZlOFvzKEPs!?*w_zZ ztMM$}#WE&uEJACP?h?XY{43Ulv$opa=jzRlCfB=+rrdb*tN_4v=+Xz|qsi89?At~)Me9YnV% zGQfswqyjIGHTB%3*IR+-u(k+e(Tq++zB$`7%NLaOATP%{Mw>?s#7W!}GJUmP@S>%)z;Qm}tBB3ycvc7I z(s!GuMf89drz*Mv_Rjj|3$u&y$%pLCpJ}^k)O#qqx0_zxSfu^}FV!St?;*|iUJv*F zoy=RDQE=^*Dn$?J4E%C@eTA04Pcw_9rH6RE%~4=B#|ya5k?3A=q03eMOB>jTdws&z zV|;EH;fxCtPy?3oM)ePnG?(@6B`pauxc2eVAo&!#c7bDeF?X5CS}%mAo(4FOm{?(z zPo?T_ynY(=7N3@RZcJ#3Rq2$6Y`i<})e8}sy@~BW*YqN60!cD0Qaz@%@K@@rdht%> z^P+_+C)Ua2DmYMVjxfN8zCjVOH)rvOZh>G*HASI!%bX9ZFxY zklJ;w%?e>ylJ*`K-SKU+X5mi((b+Ik?X+fMZq4b^a0xT> z;n@(s$ITD9`S_7>YJzP+B6?d=)}glR=9}G0Qx1O!^#`x4&4g>MlQ6B$5KvAs_a9bP z#3z^5`(eNo*9GmFqAa9^_%dAEgWx9ml`DZWk}fU|IVCFZEt>R~v@;}4G|Y+V_7 z-1tE0l(q9<<)ET_|4W^33#Tv)S}Eeb59Ynb6$M|&Gz_9ORh;0w#GU5PD=}%SB>jbD zpXbSf)1r?u?KhwTu@XgGp5)mE@y$*PxeA8>F+f-MjsDUppM|_8Va5ymlb{A!CK@Sjle2?`;m3XB`}HW;aUWe6>B- zKV0*Y>~*ANy9m!|R1K0Zi90^?9LBbBDfL`jSR{|vxEq)*{e5P5h3MexLRHF#gU`{9 z2e&HDh@lrHj?Oe~sIWN106r*{QSo?kikX}#@72RCq52+H`x0&MvkphD$0wW;{n-0z znx-3^7aVe+FG)i`Mzh)v@4p1{E3P01+TJ5cAvyl~2zWxFv0!Jgt>Im&XpwPoj&YBj zJp&i=t7q|^ak;`tqhJO>AKwrHg<#eWw#`<4^ux?UipP=(1r*WYWA8-97~?P6X-HcI zy60C^$wuH)&mGJMGNsE4b$PuREY_9>*|`Y&5K)tkR@ZMGJx`*i%r>Me zlO#edkfFCw3wAyWtVQ-9x$+8f=!#HCyZUKZRa;n2WPWh zZVttaa}SNCWs2Q=Shdx=0#sXCDn*8^1FP%o+K_}wPq{mMBu)I(>8Awdfud11Qf9C9 ztJ)s=m$U-i+#J5QkDQ3h6LEOC>KiuhPH8iZ75GMV_8+}3O?M~O}{{BqBqhC+MXV9w->Si1?Pdr;$*}DBY?ZgLp#4Hz z@`UD8CVQ9T_1z#hS@TSwvZA)JD+hoRYhJ0ZNh2n$LJRv0iQHt}^omh$OegR91~33) z%A*0iOQ5^7K4AybXs*$Q%Gm;kC1l6Rvm|yinGsWN3;^bV!Vh#S6qR#sPNI|oKX|`N zwm%dJC<}RBskJpvJq~Ow4lIW^%_+p@S(#1l?gSma)>>;U2LxQaJ=#iV*gQEDa}K3e zo9;res!m%53CHs4T^j9D+7<^#qb8Ug;~oOA?A?J?)Gp$dwMCv8e4XPbKd;~vo~3-! zrbCgZXG^xx>AJ>8z5wd|ck!>JW8aMBCsbF-#ta+}`W81(9BR}ZhWsoBpvFp4Vg8zx zkAE~Axe$Cu#wP#ds15Q=Al@nJ!A0*Wg?#|0%38=>jvBHv^6(_;qkx2w_17d$)^;V0 zFM!wIe1!-|XY(bnDZm{2J;B}?c@-`0mujWK39a6}WECjq;<$Xhl9}R-B)Yc*IzZ#L zRArp!KA~!&%bk8(Osk5%<*5xK%nO{5siMo2a;}eb49l>01(U(cqh0BC=iA*(qF`bs zm{k-LPl+~!@?<7oJcGL;SA?Hj*9#xmJ@Cp)(Hfw`2--v$DK_~?P3(F8`r(+@Hu)e+ zTy2%WlHSNsdbVF^7h-HW_30E|Ys2t>sAu{bxH2p8WSv0y(Gwb)%ZO zo9uB{)*E6Q4J>sPj*;?)md7(*fjt;c)9!p^9kedgp~>#qTPU;o`}{H|+YFtC$h|pq zqVbF@%^X|XguQGz#$?{Rrr3PI-kA&gF%wDh(}|8Ep%}1LIRHBj zc8ZsPo9^YgF)sfXQ~Cv0jm8|~P}qer+pO4fKkoHOA~`JfoO~u5az=WaR1w#4fE=10 z$#*B&Hs))i)VZL2Qo=vZTQ+-bL)Y{xC4ey)ENHKVW?Ku*%BAB$JhlQI3EqLd;=r=P zE@J}-cDfJRrXC!K7%;#aH4A4IE+r+fedQa^MfWW)3VId>dr()R+nrOzE8)UTdWj59 zC&SxX0*sdk;&SDaG8_>-GuoXH! z&VF1z&+rkk+~mb#=J9!uYbmaI7-qNqQ4#KjIsNjA++}X*Z-gB@WjjPZg6T_s@Q_)_!ZD$zM3mx5gL?nom*IM8*#y;}pB|-ypgF z_~N5*vG3zvXI&mQ*7;o3KEy?4|DZ}AJ~$yrXJ zzR?A;4CJ8p2k{^csEurFR;ZDJ;hIT%Q&g$3ocPQK-tE8?as>s|>@^$(#XQ{3?VSgR zBPG2Kp6aWf_b}~UoC_z*9?fznAk~2UybqJWSFO-Y-Ja9exfvMez#5nPr!LV7T8_)R z`e5~Kr$Oh$Yo)?6WNm;$cZF{qC~nR&vl8yTz52m5N;#au;y*73Xsm#OFFXnny%q*TYUQ1_*SG)SsJ8 ze3&og0P1c$pNEhP+2oG6z}25x%!-EhdW9BztD<3;uWmnXUn0vz_44-46A69}CBSsB zWD2?3FFo{E)c5i6_Lko-(6u;K|cTbE6WzG-q%@}rP-zF>@w2Q z&~c6Z)((Nypl|#{&%?Qq&nFq7gj0}r$wg2^b4e6!a5U<~&Mc(#HZvlj|Z>MdlgDI4l)+8sipB`)=Nu63J=5-*= z(Wh<(tXZ-7f8qW;hpPSaC#kxiw#aS9yrn7MLhS9!5%XWh2>O>Um3EyvYlrRHCq)PI zQoTf%_3Ps9an+T@^5_JY-}AazihQkRD2psmwzz8}IN)~T^saX&HZv8F_5h**ml4ge z^txxZKver=!KK5eJ}JV7hnC`5Ondaa=WS8b_I#nYVCxIFFUA{qxG(P`?~Xwpe~vFc zdHR!co;C+7Z>vTup0+8Z+d?mvuIC7?1iEZf?9{ZMbJyJwhT$X@xISgEf7mJ~MA;w|!T8b@P*hnW^eiJL#AAz0#1u=<~#b zoP{ic7e=0Ltjvn6S+uj!Unl4z_F6MLCrZp9FF&MJXuorD(A;dQq)i5Vd+#V*10UNCE8yNZbLLag)^8H zDX7%TPq@$Uv0i=HW3$$ae9P;4#`i8iXGLKTdqq){T5Vxxyi=d#{0jP^zo<3i`2sc< zOrE&xITeVIqY$fz#&W*Vw+9CbZ@GjG_B)%mb+sb<^z5sT1>Qdh6D-!}TmIPMZQ!tD zW4oUWAlD*Iw!0@ju;rPbH0G$ee-(j=DbKii-;fX9uTViH-yyi!2ZhbwY+w>=16y~3 z|K5fMGz3x2fGSzw5zB$Tt=XQ!mXlmXz^h)$b*?#uWH96n#oVRoJ-;eh>il>Rdv5fA(}y;oiHzq*oi!1GCEm$iHz2(U+9iPHf>K>5fSgow z;^-#S={~(i@APE32iAkmdOC4JumffKU6T+NfBUfHs0lPmAidw&Nf&m;J-d+l#}Q*D z#CDT05fjXN1imoFHUC7fsBV|j{ct!1A2z?w790Z-Ot8%db&mW@4?`i{o@Cmk=Gqxs zl?YJPZf`a=ABi=ym56Q_U|9I4A6kX*524!7>zsbXX62a8T#Ouk+)dUTE6SD6hWH!nzgT5bC~uy!-KeWIKK-`rra1MA|5Gir3O1?msHbgiNwP{o$tgDz#!yVxYgsrM_E*XF zh86bmJkll~l+Lc1@+)J!%}@MvsFy{M)Y=&9Ut<~GHo15kd2fk3IAoomuUO*B-j`IS zIx8v_M=Y}>ZywKJBZil@#IjBAGovPKaUXu5t6p`1{JR6L(wAUHNSd zr=IiisMTffT`J3w>%wo6m`N``b6D=O27K72p*>At<~q;pB+|h+n)@B>4M)lE>p1w> zcaOhc);1NFGMaf@8-L!@+lVK<*B!Wqg9>{Iu+()|OFCts9Sg2yqT++We7&=M$UpJm zQ^0q_cAF#b=WPaq9pwKa>bQ(tz>SMXAjHrC;r0`9^5^ql9T2~sC-nck0e(I^T?b#Xfd8lOx2RLM%)iT!K!}5S0`a_gi=L(?5%yHs z@K7j4rlKGhblwR*2O1>AFJ}igQzm+PptP!XT4&VAERgngL3?B^c#Cb@*c=AOJU|86 znU<+)jpdYGsNGWgRc;jPOaUt!TYb$hvIhuLT?Da0prAoZgWQOlv!iaJeRrOQ z`f0)gLyEJRc?0fsRM&Nzm%c$xln<(wCM3~vIB4wEp6)*a60?f>;Y!83f5R$OG>R1M zp#h)nNo$m7w{>oFpn>*wIiZ+`0aZtJ7x&v8lW#rHH0UA>4*Do?T!C6r0!GP^wB<8< z*JIkTvHt7bVA<+94>9(x<7DOn_NobX z=xZZIbA~Vdp7~c;8`aLOK5{`gs&{BYJlg}(Lfipmylqe+3PPFYD1Rt_C87lymjrafLIlGkYVoNJ{ld1 zO(CCA)t`p)qE;#^xa`R~Fr^5J9xK$m2N@YhZU9#G(*}iDSdq30v2~suWT2mw732SW z=~pB|yp)+DH|l1gx7){V;>1R!PiKDpOz$`CP%dvM28so>1f(Ddod|1J%_bRSogzz` z5u&+G)ba8AUHEN?{{gP@JQ73}wb({2f)Fu~Ru1Hv#$Sl#-;%@;^W!|#YEYVIrb|pY z)HDE;04~1tCp4r!0!3XcNsFJ4W&+u3I`2p}RMGVq$j|!q`yn|f^8!3#2s|59MSyw( zvOzA1Nu|U#BjZ=d@dT-@2se%_s7w!hC(rhS;JYm2yhz4CjGj^g&fG6fypU?!`37m?j6gT7XlxHwFn5ndh0m z?kYCT^ScG1t^n=oLNCN8_I7~m@1w&u&(x1zh)t=R5#n({1hEFPNX>|m;YeLt@TmQV z4sq(40EZB5mF!l(4@jOO`H`*50_;y5p;#f1MU?724u7IV4FFPQ%tX1~hqq@~xa!g<$ix zt15lmpT~ZKMazBb?AOf^*O^C$wT=DR%+V?d(mZs8{xr=g&|N_eL5V(e0SMhz-+rTk zT6qS7ovZ%aqq!7LztS941QK(!I$4fVEW|4R#3{YZ_$_%HZ!2}~GR8F!V2Q=>511rn zp=`3_2gC-sq9za)b#y|Z-sCjAg3?Le9kp73MD9a6(po@4f-<^YhI)WK&shE%Hva)a zr5}k>7p*sT^=CM658&*G^PgBjcjnpBXZ>KFw-X5Q{f)Ke*m7eK60v~jnvDI&FWH_6 z#TeBK;}@rr-c}vVOSG-s8;||Rk7u4WdC}5buMRp0l^z;#RP6mrlV@M^r0MIhfBgM{ zsz=d_+O6rgO?g5wk-ioaO~curT*!(4@QrV1AaDwN1PDHUyEAuWyh$7mKu*aR`bRH$ zyX*_qGKhPYkzB8)QiDog+F+MmlMJUQx%kA#&F{v%$dsYJOdRO(r&_;A1mS+oalgP^ z2@q$+p*+963BK<2_qn|5-dvaK7=RZgI*pE4(#ITAdq2lQ-8xxE$e=3jj*dd)Yt{|E zCW_1LWV3Sk6&L)mSNtoEDo*8_AygiCCOekJ+SpS)I2v|DRfhPoX!X);THkwnC;WOc zut`eCXd+bJw$>Wgy%7}1Au@2CIUVAA&wpmzpzfpp#oV2q+A%z#LZSB!LXrc9pZaBu z9e=u1Hm9-mjoWWa_-tK%MwUw7Ev2C}Ir*EkHr#jtBlTA$NW|{{h0#kY({{DHvZk2J zWIyKkfE4dYpL;ogO*SpX=}&Xb)oCm3O8%8yKw6`Iob_?(+yc)wCpdO zzxCe#(*0G7#7~DUux6|nN!E&M|3zu|hl%9p?Y{t89H>E!9L0Ly2D1Re74lDz{I0zG zw8%9|&Hoek|JQ&95V2w+`dMFqGG<=9ETB2*m77TL01V=PWASU0)wP&~1iDov_P=od zQ*DKKu7&kTc3;j!A~!d;|Doz*w=drha~?1AR~64LMi5wJWo6?Ebloau`ofQgeu+Wu z&9g`VeV0}=TJy&xzH6rcbdnnVtV%SV395Kt8W$2=<=ExPS=AWz88mSjh^(jSWKMn~Cp0&3hy3^gBi=Su-bN&xQg~lrs6D$Laet!R&3H*p zg$Xh|MxhNKtpS{VT$gb~6Yy0R*6Q&GpO?{DOc+}-pS#5fR`F8S!ccY1GIr=u+c%$% z&B(xCtJ1?X2jj{|3!n^nIP+ZoOXMQc@U4If+q}c*sm0SOpv4z|@{N|vptUf{w0;n8 zvqLuzelARKXRK!4Q;RNnas%>o-r3W*JWfz_ROBGo??y6H4NZNtY`;Br54W=GGc(qbvrB*Dg}U0Fm?SBp$;+&BCIP;az%WR?^^De)(}=anr(&M? zosb(4PY1T7+QC}^OD(FoEGuNhotY4`1{y<(DSl@4GeS{4M66A#q)>tIv|akw22G97 zIWd%NewnT3AZKsEbX{rCiXqV;_wpJJRje>M@LDDmLl#NO9K0Dx<8i^}JCNFq`}B|| zQNB47|MWE;6Y_XuyJ3}TK_c1CH)8^^n0sqs08gvcQ~AE(&}M6y_gqavRETXp@=?uS zd6NnKE~S@%^mS{&tXY5&2fX}{?J)%*_7hn+Vz-52rs`&ZFbMvw`Y-=m3&*k>;@L3+WFJAnpeByJA|Q-))}ki{il z!)E)|SbOGb2G9Iutb~iLRR>KGbKbm>BoIaFi_$AZ0CHw=wqXvTx=oopCcwvCh$OU+kxVw#^eYhhd>J7gRJ zpI#p)*<{Ovnn;4x_|<_=Fp;G8DkuV9T^jKezKx-DoeMrv97yoXOM_*gZ zQ+DB|4b1mFa`&%5OcBKDC3o27C(R08Bz+a)xl^H!=hj>y=r&u@+RY;=%BobOD%YEl zAp9y5Ich3ga8lp+x^ByikiY`b29d5|gffVB{VMF9O za_e0vFWDU77S((~r2g@VL zx!F&eUr2E=*fY=iKJ)WL4}fC11ibWG3@(28Klmfes06)NW1NC ziWTS!5h000br2omRaf>SDU+LS4;>4q%wotikl zbboMsEGXgPxH-p{rWM2gs$sHAsz#$mUzL-T>3i^mI_TOP5gbvv9iN9N6h#d-du!c|_2} zm}5gQ_2b)@I41)Qdh07>lu|oa{;Jx>CZrULQAp@nP%VAMe|14Ej6POK8-Ps-M=j7rXneX<=vmS%b6f;+2 zI(kAN5*#XI@KZQ^)UEnaeN~#F0*&3D7fy}N&NS1d%qBC%4ldMJQ{EZJ1HXD@?&D*b zQ+r+k8>y*QN}lKtCl3GQeky|>_2}~8fLGA8 zb$x8}I|+}4N5FZ}1!_SGg&!Ro%G@Zpti9-$M6t>rp7BtnA>_yg3puh?85$_j;K*{? znbVX7Uw7c<@MD&vG|()aG2ZKmDvRwuK_wC_@j0GR)NEb9Q(|oy&D*?>$f>>NuEKuXma|58Fgd zih4wb56*)ook`JzDtI0?y;jd86a>rkC%skA*1E#+_d^YH(&7ofJ;TLC^Z_GGHr1+N zLa~m6H=_vZgMG>QE^U0%P}oT_+NTRjx2YfXzkl>2O%+G*>6$)pk>!*2nu#zx=*gxB z-bc2@?4IxoObkC@RIkXYFpzm+nasxRfjJl>=d%9=bK9PmM1nwbqV??( z<&U(pZN}nGXw`3XnLB+!iD@&(8z0O?2GSp?v;X`-%k${Q5&UF+1Hsx4_!SQS__ZW! zUK#2Z|B6$2)A8oL)Ys!KZu8lLag@=8FEU=Fw`czGn?FJ9KR@B$ul3g*Ul{mW#_j5G zxVOhs#a3g!MQ zXbT2`g7Fx+{T6XK-}eymDt%2<2T!I++hu7pgk0GA=!-Ej_iRs4H&G zS}E_@diTj&kM&6J_$940=lTVC@c#-? z;o7`wLW40BXItwfPy$v4pSr(a_|opt+%^l`d}-HuuB-ItU*{-?A2yqUHxKp3kl7LF z`yq|F!8n8Qwn_3W)Ye6D!q-j9g#khRifQ36V5b9?B>Ul{`>~-{P4fFDpoy20%4S^* z=e`g+C?Mb{D-jurvDOO*1-UZBlA2XGY`+sm8Yy;x>EJpMt&X=h8$ynGpNwlp1zpaN zpFYXbCNP2>D-oPWkapfxE@wWq>?`5}UU)V(ohg6AY%JKxAZPDjvjUb1_0_2#o%zU# zv2|kr>29K4p%~uW#hJ1jC1S=z+aF&U)FD&Ju!C+Je&h}7h17w)5wln5sU-&YVlxIj zb`8-EJM2*mZlN3kQ6V8BG_Q$R0pK3`DzVg+X6{^}v~Z4Tj~$!@e@ z)*K25>dL~m%}keIc*4o~rK(Ym!^o>TH5#eM$aW=dGCQ_z!ymcVeDk3czq(r#U=A(# z)To}swB0;c3H=c)lAGKfFGs*6*8?st<%n7TEc7Idmd-qr8ONzKNVly2M-pxC%|Jv`ap6u;{l4XDD+*s$A1^?T}ojTI% zElNw5ti}P`%l&%uh(ib!=Q_bETrlw_1rfXyRnUGs`>Wqv`zQ#s8mdTL5FG}G7C17J zlL?3>!ib*6d!O^KKl8C(9CNLfVpXXTj`DJ3HNV90W1?xC-R>|2wke+APb$UIUzcm* zFA#XFo1y5IyTEd`3Jq*F`aY9!=wSZTw!|}yukqrH$d0}Kl4p`85Sx}LNXNLT_*gux zryhINt#rk`3{>M4SMT!a@`OclG&iS31}9vxrT@wWKEkh~6143Tq-fzk$7^J5nPewg;9T#D zXQH`sM_$pp-+PfjPlO_ZB$ZirIT|g;I?RAdRJZGat{#j3lgaUWxXl_deK}f1jCbiv zlUvA_uctxVw((wIN@|~Y7X>-UB7QaALTUEKth2c>Rv8R;j;!my%i; zC{QGx5P?ibe|7{5HPQ^9V+t`FWN-a_LKz2*Hp{WnXomSq}7?lN%CZ;<8r(hZf< zSndov&2&NhG*ny`z{Oaw5kXa;ZEZ9zIpVc5uvrb9m&kXed|9VyhAAj;6y>&8H zqaCF}qokI_D;qDwLS5fLG^Z8nR}er}#neYoaij5leb2Ny>?{?E^SZWLE&S=hTe`-F zUmjy?963G!l`4S_X3(6?8wEwVtkKB;orC2f1D%Rodi~9lQCN4ay%YneI9v~d&N}Vmy}+Nlzstz=SA-}P zTOOOODe_nr8T8&+SEsw(7GGu@T*tR}0zE4U z%!R?h+GqdK@^(-pC|}ijHC55~N#xwe=trCU)kUd^mw~ac>8mFwfe*HOWUfUZgwfet zV+U05yt-~MK`hPH;mWBN2a%OB;3=P{j02t%ULsXqI8=CL@@&p5j|rDT zd^sy@fa<#%+C{SmV%Z9qUe0Im(JYIe9tJ? z?wi8N?*@~DNIgDzQCl#_|L}@kLp`EM%L{Y0p03?0>;^obWARBBH|b;5bx*) zmv6fd7C}kgse!CiaMf%@vvB3Vc{HS^edgIt{N?_)%yh8Wk7LXqGRjg9T<66dE$hea4C;OyZzLaFvK=Qax*TpTN zIT3pE9YQ+!C390Lm*vXGIQL&4t#6$)P3PO_)r#JNo_)weo_;##@u{M`i4X#od-ASl3XozC>S3~-uCcLGoIwbchy!}w_V*1+a7ClX~+89E;MsV zL4}Y7&+c2H;;oa{U0X%4+$Cu`w+YqWB)Sn+~ae;1UUuih>hg+ z|9|aWTU3)-mX3>6MNccis#3X=vWO_HK+zOX5-wFLh0z8|5QB{&G!(E9LtwZh2qD#l z1|=vM(0~EbmLMod$mJ)=1m|I<=V6{^=3!Q?bsqP> z&)(nK`}@v1YyJCdu!5*;2{5qP50lhr?e{1$X-wOW~yeFrT z1esvO+#hl4cVNM^-?8`|i+`uV-|ON(B*8F`Doo0o5Y3b30hQ-Hr6nk;@;_71|DI^P zYAfU!~=b>%>%(woB|p(`Wab0zGL+-lD65^)ImQbo^2=#Z&i? zI_@1KmWyJ=9EMX(x9YIX^;~kjTTX^ScW@-Z(4D?exZzocj8kd%CzrLWB!;%W;?nqV=SGuh`B}I z6j(df-4Czr&eR*%4yvPUo;| zq=W_h(==h7$4g*k4$&vcXyfQyu=l87kbI=4@z+7wle`i)5apR}RuK^3Qv0U61y*7H zZgFIowhs=-*Qcq9DL$o)=|pqsO^3<;rdG!a8+Hn$i!Kzq%b&XD0ZX zOE@&6B7l;U(k}8A^T_r1Tr)-vZ6BO9ApwlfJhgVTH7*7hq1S*iJ{LXCPWS`G-~_6v zhY$=9r@9;A(sPrwFG?`Cf=`k+rX^V<`rxm?m7%z5k6~ctk+NX!^5sI+fE*>@)H-Gk;Z z$fvQwZaJGz$R9jO59c9R7iUh!&DOp!s^7lUg>DszM~Ed~u=(qFijB#cWJX_eU5pJ_ zfJ>hBUBz|2|AdYQF7rQ+DR4<=^&+<%cHS%UCPg)ldKh7&kv#ka6-@a4NZ#6{$n73a z*B}G)e#*?ZOu=l5w<>#AN$9y@(WU}dVxBMF0qij-2}Yh{kdMzElUDs^uMykp9@pvJ zdYiR!JH0r<^V)1i19dBLG^+R5kB1S45UeWaU0w#2hhCyd0dVc;BJY zXW9fE+sgmHT@5t%plC;9^5fmc4qT4Pg6kW|(vE+{dc_vHiSQkwtYk=5WTE*NSgpUG zE)HOy8{o*W$k+H@v)9h3%%xRf$$}H_?ts%cb8%MSMmY7GV6;bMSo}@}ggDw08Pu!& zp#`<7!|fJ7%q4FMd>M918zlt7kmh!X!g0NXg1}Hb+sJo^k9lyN$;)0|JMHhvyAm<5 z2S)yGB_tm>^-v$@JH3Aquh$?FzGk*g5dfMCd+=^h#GK8QzCKeXo(!!$)`oIYgU-2b zyik-naM_dQ7y=)`7IPEI1W7-9O^mkI!#fTctpgqHxwOUW(jL*GZ{9kNn(+Pe^t&DD zH)5g>Irl5+o}U&c?jc2)Hp={W9w&E(83L2#eXgu5h&h@m8pGhYr5ukw%Z}W2y#QOb2wfq;e?SpwFM00$#QDGqju3UKA%9 zFmz!%6NN~1cQK+B4fud%LjDbCDnzZhJ=%)+nS1lY^q1-UJ7;`%?ntc52W)t@?E6=V z{Y~06TPr0~Io8vdH*lufxWk1Ic%RT&L%@@zA`WXj^M1YBu43PddzG9jD62>=#B=XOMO_Z&D z^P3z{l(sdgIq#A5FDs#`NJC$9qV^U;TAuOdWLirz(6bM2-w_=lb8I%sXyJJ69`5wa zN?3=dF`~xsx-_qt!8)DIPr&(X>ivhhBhlJ`)zM7i#Z!bw*czCc41L(l!RG7`uIeL@ zF9tNegGCrJ)QJ%dh^j1_6o&$e7pQNJ36g56ZI4{boH*n678c$w44-7k*5>(v4L-(n zioPteRPC??g%3-Wu}=LAwVM7H)V?~h^r<&|tl_+XyI=L)SnHCoP%xjSb*+u3Zr&Sn z+uZq3?~lzB+=`~GZY;Mq<F6t04c=dcSIW|EK;6>JUTT>a z(WRuM+*DdWqb)u3_D`}n3-p1)=bjT$-aQMGue%V{YTCtiDOlTO(P_MyZGJe$?5~BB zQhVtP5n~X&ZdaVpmRkHBDuK?t`{jmtE)tGi<0WC1Fe5zmnjVGd#8IscTEcJDY42k(N46RM)N<@)>Dmc$XPF*2J+$KPX+#e8_~R#bYr%gc*Po28!60gr z5LcfHS~-VvzC(tHEg)0`vaC^JnEoth}jL;3us+*6Ju{xn@H-C4wKBJ2}PnR3ly z6iFaRZP{WgjoRpmoavIwoYwvx0w-T*A(FTuZZeO`Y1e+g)R7)od14><1SiLW=_Nx= z`@VtnqVtDv6L&2Pmy;_FN}zCiRM5G&kIQJ~qalE9AF1Zv6ek97|4cj^8ffLJm@CVSK3jlNDaY^v zl~C*V*Bo5T{-9*4MF|u>JGp!qU>p> z1@VmP!v@;@ym!VNVt Date: Wed, 14 Jul 2021 16:15:31 -0700 Subject: [PATCH 02/15] - Update Onyx port after significant Onyx system update (#617) - Update unit test output and scripts to differentiate completed runs and successful testing better - sumchk is not passing on Onyx due to issues in the global reduction at real*16 and real*4. This seems to be a software bug in mpich and a report has been issued to Onyx admins. --- cicecore/drivers/unittest/bcstchk/bcstchk.F90 | 5 ++-- cicecore/drivers/unittest/calchk/calchk.F90 | 5 ++-- .../unittest/helloworld/helloworld.F90 | 3 ++- cicecore/drivers/unittest/sumchk/sumchk.F90 | 5 ++-- configuration/scripts/cice.run.setup.csh | 2 +- .../scripts/machines/Macros.onyx_cray | 2 +- .../scripts/machines/Macros.onyx_gnu | 2 +- configuration/scripts/machines/env.onyx_cray | 13 ++++----- configuration/scripts/machines/env.onyx_gnu | 13 ++++----- configuration/scripts/machines/env.onyx_intel | 13 ++++----- .../scripts/tests/test_unittest.script | 27 ++++++++++++------- doc/source/user_guide/ug_testing.rst | 6 +++++ 12 files changed, 59 insertions(+), 37 deletions(-) diff --git a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 index e5cadc805..4b723a391 100644 --- a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 +++ b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 @@ -257,10 +257,11 @@ program bcstchk write(6,*) errorflag1(k),stringflag1(k) enddo write(6,*) ' ' + write(6,*) 'BCSTCHK COMPLETED SUCCESSFULLY' if (errorflag0 == passflag) then - write(6,*) 'BCSTCHK COMPLETED SUCCESSFULLY' + write(6,*) 'BCSTCHK TEST COMPLETED SUCCESSFULLY' else - write(6,*) 'BCSTCHK FAILED' + write(6,*) 'BCSTCHK TEST FAILED' endif endif diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 index 09a297f1f..345782281 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -579,10 +579,11 @@ program calchk 1002 format(a,i10,1x,a) write(6,*) ' ' + write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' if (errorflag0 == passflag) then - write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' + write(6,*) 'CALCHK TEST COMPLETED SUCCESSFULLY' else - write(6,*) 'CALCHK FAILED' + write(6,*) 'CALCHK TEST FAILED' endif end program diff --git a/cicecore/drivers/unittest/helloworld/helloworld.F90 b/cicecore/drivers/unittest/helloworld/helloworld.F90 index 651436bea..435d5479e 100644 --- a/cicecore/drivers/unittest/helloworld/helloworld.F90 +++ b/cicecore/drivers/unittest/helloworld/helloworld.F90 @@ -2,7 +2,8 @@ program hello_world write(6,*) 'hello_world' - write(6,*) 'COMPLETED SUCCESSFULLY' + write(6,*) 'hello_world COMPLETED SUCCESSFULLY' + write(6,*) 'hello_world TEST COMPLETED SUCCESSFULLY' end program diff --git a/cicecore/drivers/unittest/sumchk/sumchk.F90 b/cicecore/drivers/unittest/sumchk/sumchk.F90 index e3b99b59d..210ca669f 100644 --- a/cicecore/drivers/unittest/sumchk/sumchk.F90 +++ b/cicecore/drivers/unittest/sumchk/sumchk.F90 @@ -674,10 +674,11 @@ program sumchk write(6,*) errorflag4(k),stringflag4(k) enddo write(6,*) ' ' + write(6,*) 'SUMCHK COMPLETED SUCCESSFULLY' if (errorflag0 == passflag) then - write(6,*) 'SUMCHK COMPLETED SUCCESSFULLY' + write(6,*) 'SUMCHK TEST COMPLETED SUCCESSFULLY' else - write(6,*) 'SUMCHK FAILED' + write(6,*) 'SUMCHK TEST FAILED' endif write(6,*) ' ' write(6,*) '==========================================================' diff --git a/configuration/scripts/cice.run.setup.csh b/configuration/scripts/cice.run.setup.csh index ea8efeb03..aa578b5ca 100755 --- a/configuration/scripts/cice.run.setup.csh +++ b/configuration/scripts/cice.run.setup.csh @@ -100,7 +100,7 @@ else echo "Run completed successfully" echo "\`date\` \${0}: Run completed successfully" >> \${ICE_CASEDIR}/README.case else - echo "CICE run did NOT complete" + echo "Run did NOT complete" echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case exit -1 endif diff --git a/configuration/scripts/machines/Macros.onyx_cray b/configuration/scripts/machines/Macros.onyx_cray index 6753a78e5..c088d1fd4 100644 --- a/configuration/scripts/machines/Macros.onyx_cray +++ b/configuration/scripts/machines/Macros.onyx_cray @@ -3,7 +3,7 @@ #============================================================================== CPP := ftn -e P -CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CPPDEFS := -DFORTRANUNDERSCORE -DNO_R16 ${ICE_CPPDEFS} CFLAGS := -c -O2 -h fp0 FIXEDFLAGS := -132 diff --git a/configuration/scripts/machines/Macros.onyx_gnu b/configuration/scripts/machines/Macros.onyx_gnu index 890e29e31..31d0e64aa 100644 --- a/configuration/scripts/machines/Macros.onyx_gnu +++ b/configuration/scripts/machines/Macros.onyx_gnu @@ -8,7 +8,7 @@ CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form -FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none +FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none -fallow-argument-mismatch FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/env.onyx_cray b/configuration/scripts/machines/env.onyx_cray index b155c1d1e..38785a27d 100755 --- a/configuration/scripts/machines/env.onyx_cray +++ b/configuration/scripts/machines/env.onyx_cray @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-cray/6.0.4 +module load PrgEnv-cray/6.0.9 module unload cce -module load cce/8.6.4 +module load cce/11.0.2 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.3 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME cray -setenv ICE_MACHINE_ENVINFO "Cray cce/8.6.4, cray-mpich/7.6.3, netcdf/4.4.1.1.3" +setenv ICE_MACHINE_ENVINFO "Cray cce/11.0.2, cray-mpich/7.7.16, netcdf/4.7.4.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_gnu b/configuration/scripts/machines/env.onyx_gnu index de7bcc787..699c01559 100755 --- a/configuration/scripts/machines/env.onyx_gnu +++ b/configuration/scripts/machines/env.onyx_gnu @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-gnu/6.0.4 +module load PrgEnv-gnu/6.0.9 module unload gcc -module load gcc/7.2.0 +module load gcc/10.2.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.2 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu -setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 7.2.0 20170814, cray-mpich/7.6.2, netcdf/4.4.1.1.3" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.2.0, cray-mpich/7.7.16, netcdf/4.7.4.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_intel b/configuration/scripts/machines/env.onyx_intel index df42fe9f8..39f25e8e5 100755 --- a/configuration/scripts/machines/env.onyx_intel +++ b/configuration/scripts/machines/env.onyx_intel @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-intel/6.0.4 +module load PrgEnv-intel/6.0.9 module unload intel -module load intel/17.0.1.132 +module load intel/19.1.3.304 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.2 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 17.0.1 20161005, cray-mpich/7.6.2, netcdf/4.4.1.1.3" +setenv ICE_MACHINE_ENVINFO "ifort 19.1.3.304, cray-mpich/7.7.16, netcdf/4.7.4.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/tests/test_unittest.script b/configuration/scripts/tests/test_unittest.script index 5f37b15ac..1db8dfe60 100644 --- a/configuration/scripts/tests/test_unittest.script +++ b/configuration/scripts/tests/test_unittest.script @@ -4,24 +4,33 @@ # cice.run returns -1 if run did not complete successfully ./cice.run -set res="$status" +set rres="$status" set log_file = `ls -t1 ${ICE_RUNDIR}/cice.runlog* | head -1` +grep ' TEST COMPLETED SUCCESSFULLY' ${log_file} +set tres="$status" + mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} run" >! ${ICE_CASEDIR}/test_output mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev cat ${ICE_CASEDIR}/test_output.prev | grep -iv "${ICE_TESTNAME} test" >! ${ICE_CASEDIR}/test_output rm -f ${ICE_CASEDIR}/test_output.prev -set grade = PASS -if ( $res != 0 ) then - set grade = FAIL - echo "$grade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output - echo "$grade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output - exit 99 +set rgrade = PASS +if ( $rres != 0 ) then + set rgrade = FAIL +endif +set tgrade = PASS +if ( $tres != 0 ) then + set tgrade = FAIL endif -echo "$grade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output -echo "$grade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output +echo "$rgrade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output +echo "$tgrade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output + +if ( "$rgrade" == "FAIL" || "$tgrade" == "FAIL") then + echo "ERROR: Test failed" + exit 99 +endif diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index f2bc62656..2fadeacd0 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -667,6 +667,12 @@ in **configuration/scripts/options**. In particular, **ICE_DRVOPT** and **configuration/scripts/Makefile** and create a target for the unit test. The unit tests calchk or helloworld can be used as examples. +The following strings should be written to the log file at the end of the unit test run. +The string "COMPLETED SUCCESSFULLY" will indicate the run ran to completion. The string +"TEST COMPLETED SUCCESSFULLY" will indicate all the unit testing passed during the run. +These strings will be queried by the testing scripts and will impact the test reporting. +See other unit tests for examples about how these strings could be written. + The following are brief descriptions of some of the current unit tests, - **bcstchk** is a unit test that exercises the methods in ice_broadcast.F90. This test does not From 36799ecff2b9a7f3f9fa42d641c2c152f597256c Mon Sep 17 00:00:00 2001 From: Tony Craig Date: Fri, 16 Jul 2021 11:49:53 -0700 Subject: [PATCH 03/15] Fix 1x1 and 2x2 blocksize error (#618) - Fix 1x1 and 2x2 non-bit-for-bit results. It turns out the 1x1 and 2x2 blocks were bit-for-bit physicallly. The problem was that a set of blocks were "land block eliminated" near the equator incorrectly. These blocks never have sea ice form, so it's not a problem scientifically, but it changes the masking and restart files. The fix is a one line change in ice_domain.F90 which that sets the minimum "flat" value to 1. This error could only happen in cases where the blocks were within 0.5 degrees of the equator, and a set of conditions were required where an active gridcell was set to inactive which then resulted in the entire block being eliminated. - Update the initialization of ARRAY_G in the gather_global_ext interfaces. Get rid of older, more complex approach which left some blocks uninitialized. - Set psalt(n) to zero by default. Was uninitialized in cases where vice=0. - Add a test to check bit-for-bit in log files for 1x1 blocks with bfbflag set to reprosum. --- .../cicedynB/analysis/ice_diagnostics.F90 | 1 + .../comm/mpi/ice_gather_scatter.F90 | 136 ++---------------- .../comm/serial/ice_gather_scatter.F90 | 38 +---- .../cicedynB/infrastructure/ice_domain.F90 | 2 +- configuration/scripts/tests/reprosum_suite.ts | 1 + 5 files changed, 23 insertions(+), 155 deletions(-) diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index 6b9b32301..760952fc5 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -825,6 +825,7 @@ subroutine runtime_diags (dt) enddo endif endif + psalt(n) = c0 if (vice(i,j,iblk) /= c0) psalt(n) = work2(i,j,iblk)/vice(i,j,iblk) pTsfc(n) = trcr(i,j,nt_Tsfc,iblk) ! ice/snow sfc temperature pevap(n) = evap(i,j,iblk)*dt/rhoi ! sublimation/condensation diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 index 010a5c8c4..5f0d0af89 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -636,6 +636,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) else special_value = spval_dbl endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -744,92 +745,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - !*** fill land blocks with special values - - else if (src_dist%blockLocation(n) == 0) then - - this_block = get_block(n,n) - - ! interior - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - -#ifdef CICE_IN_NEMO -!echmod: this code is temporarily wrapped for nemo pending further testing elsewhere - ! fill ghost cells - if (this_block%jblock == 1) then - ! south block - do j=1, nghost - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost,j) = special_value - end do - end do - if (this_block%iblock == 1) then - ! southwest corner - do j=1, nghost - do i=1, nghost - ARRAY_G(i,j) = special_value - end do - end do - endif - endif - if (this_block%jblock == nblocks_y) then - ! north block - do j=1, nghost - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - ny_global + nghost + j) = special_value - end do - end do - if (this_block%iblock == nblocks_x) then - ! northeast corner - do j=1, nghost - do i=1, nghost - ARRAY_G(nx-i+1, ny-j+1) = special_value - end do - end do - endif - endif - if (this_block%iblock == 1) then - ! west block - do j=this_block%jlo,this_block%jhi - do i=1, nghost - ARRAY_G(i,this_block%j_glob(j)+nghost) = special_value - end do - end do - if (this_block%jblock == nblocks_y) then - ! northwest corner - do j=1, nghost - do i=1, nghost - ARRAY_G(i, ny-j+1) = special_value - end do - end do - endif - endif - if (this_block%iblock == nblocks_x) then - ! east block - do j=this_block%jlo,this_block%jhi - do i=1, nghost - ARRAY_G(nx_global + nghost + i, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - if (this_block%jblock == 1) then - ! southeast corner - do j=1, nghost - do i=1, nghost - ARRAY_G( nx-i+1,j) = special_value - end do - end do - endif - endif -#endif - - endif + endif ! src_dist%blockLocation end do @@ -939,7 +855,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) ! !----------------------------------------------------------------------- - else + else ! master task allocate(snd_request(nblocks_tot), & snd_status (MPI_STATUS_SIZE, nblocks_tot)) @@ -960,7 +876,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) call MPI_WAITALL(nsends, snd_request, snd_status, ierr) deallocate(snd_request, snd_status) - endif + endif ! master task if (add_mpi_barriers) then call ice_barrier() @@ -1028,8 +944,9 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) if (present(spc_val)) then special_value = spc_val else - special_value = 0 !MHRI NOTE: 0,1,-999,??? + special_value = -9999 endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -1138,21 +1055,7 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - !*** fill land blocks with special values - - else if (src_dist%blockLocation(n) == 0) then - - this_block = get_block(n,n) - - ! interior - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - - endif + endif ! src_dist%blockLocation end do @@ -1262,7 +1165,7 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) ! !----------------------------------------------------------------------- - else + else ! master task allocate(snd_request(nblocks_tot), & snd_status (MPI_STATUS_SIZE, nblocks_tot)) @@ -1283,7 +1186,7 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) call MPI_WAITALL(nsends, snd_request, snd_status, ierr) deallocate(snd_request, snd_status) - endif + endif ! master task if (add_mpi_barriers) then call ice_barrier() @@ -1353,6 +1256,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) else special_value = .false. !MHRI NOTE: .true./.false. ??? endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -1461,21 +1365,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - !*** fill land blocks with special values - - else if (src_dist%blockLocation(n) == 0) then - - this_block = get_block(n,n) - - ! interior - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - - endif + endif ! src_dist%blockLocation end do @@ -1585,7 +1475,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) ! !----------------------------------------------------------------------- - else + else ! master task allocate(snd_request(nblocks_tot), & snd_status (MPI_STATUS_SIZE, nblocks_tot)) @@ -1606,7 +1496,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) call MPI_WAITALL(nsends, snd_request, snd_status, ierr) deallocate(snd_request, snd_status) - endif + endif ! master task if (add_mpi_barriers) then call ice_barrier() diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 index 418c80f61..515cdfa65 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 @@ -373,6 +373,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) else special_value = spval_dbl endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -477,16 +478,7 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - else !*** fill land blocks with special values - - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - - endif + endif ! src_dist%blockLocation end do @@ -537,8 +529,9 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) if (present(spc_val)) then special_value = spc_val else - special_value = 0 !MHRI: 0,1,999,-999 ?? + special_value = -9999 endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -643,16 +636,7 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - else !*** fill land blocks with special values - - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - - endif + endif ! src_dist%blockLocation end do @@ -705,6 +689,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) else special_value = .false. !MHRI: true/false endif + ARRAY_G = special_value nx = nx_global + 2*nghost ny = ny_global + 2*nghost @@ -809,16 +794,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif endif - else !*** fill land blocks with special values - - do j=this_block%jlo,this_block%jhi - do i=this_block%ilo,this_block%ihi - ARRAY_G(this_block%i_glob(i)+nghost, & - this_block%j_glob(j)+nghost) = special_value - end do - end do - - endif + endif ! src_dist%blockLocation end do diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index 52f0da850..1dfdd0428 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -441,7 +441,7 @@ subroutine init_domain_distribution(KMTG,ULATG) !---------------------------------------------------------------------- if (distribution_wght == 'latitude') then - flat = NINT(abs(ULATG*rad_to_deg), int_kind) ! linear function + flat = max(NINT(abs(ULATG*rad_to_deg), int_kind),1) ! linear function else flat = 1 endif diff --git a/configuration/scripts/tests/reprosum_suite.ts b/configuration/scripts/tests/reprosum_suite.ts index d65370e0a..dd6a6d56b 100644 --- a/configuration/scripts/tests/reprosum_suite.ts +++ b/configuration/scripts/tests/reprosum_suite.ts @@ -8,4 +8,5 @@ logbfb gx3 1x20x5x29x80 dsectrobin,diag1,short,reprosum l logbfb gx3 8x2x8x10x20 droundrobin,diag1,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum logbfb gx3 6x2x50x58x1 droundrobin,diag1,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum logbfb gx3 6x2x4x29x18 dspacecurve,diag1,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum +logbfb gx3 17x2x1x1x800 droundrobin,diag1,maskhalo,reprosum logbfb_gx3_4x2x25x29x4_diag1_dslenderX2_reprosum #logbfb gx3 8x2x8x10x20 droundrobin,diag1 logbfb_gx3_4x2x25x29x4_diag1_dslenderX2 From a35724c929a9b59212fc4f104aa1a2dcb17291dd Mon Sep 17 00:00:00 2001 From: Robert Grumbine Date: Wed, 4 Aug 2021 14:54:18 -0400 Subject: [PATCH 04/15] Develop (#620) * port to gaea --- configuration/scripts/cice.batch.csh | 17 ++++++ configuration/scripts/cice.launch.csh | 6 ++ .../scripts/machines/Macros.gaea_intel | 56 +++++++++++++++++++ configuration/scripts/machines/env.gaea_intel | 34 +++++++++++ 4 files changed, 113 insertions(+) create mode 100644 configuration/scripts/machines/Macros.gaea_intel create mode 100755 configuration/scripts/machines/env.gaea_intel diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 902abb56b..024270039 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -226,6 +226,23 @@ cat >> ${jobfile} << EOFB #PBS -l walltime=${batchtime} EOFB +else if (${ICE_MACHINE} =~ gaea*) then +cat >> ${jobfile} << EOFB +#SBATCH -J ${ICE_CASENAME} +#SBATCH --partition=batch +#SBATCH --qos=${queue} +#SBATCH --account=nggps_emc +#SBATCH --clusters=c3 +#SBATCH --time=${batchtime} +#SBATCH --nodes=${nnodes} +#SBATCH --ntasks-per-node=${taskpernodelimit} +#SBATCH --cpus-per-task=${nthrds} +#SBATCH -e slurm%j.err +#SBATCH -o slurm%j.out +##SBATCH --mail-type FAIL +##SBATCH --mail-user=xxx@noaa.gov +EOFB + else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index 7d45a387f..40b8996b4 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -165,6 +165,12 @@ aprun -n ${ntasks} -N ${taskpernodelimit} -d ${nthrds} ./cice >&! \$ICE_RUNLOG_F EOFR endif +#======= +else if (${ICE_MACHINE} =~ gaea*) then +cat >> ${jobfile} << EOFR +srun -n ${ntasks} -c ${nthrds} ./cice >&! \$ICE_RUNLOG_FILE +EOFR + #======= else if (${ICE_MACHINE} =~ hera*) then cat >> ${jobfile} << EOFR diff --git a/configuration/scripts/machines/Macros.gaea_intel b/configuration/scripts/machines/Macros.gaea_intel new file mode 100644 index 000000000..f4c4d2cbe --- /dev/null +++ b/configuration/scripts/machines/Macros.gaea_intel @@ -0,0 +1,56 @@ +#============================================================================== +# Makefile macros for NOAA hera, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -xHost + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +else + FFLAGS += -O2 +endif + +SCC := cc +SFC := ftn +MPICC := cc +MPIFC := ftn + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF) + +PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs + +#PNETCDF_PATH := $(PNETCDF) +#PNETCDF_PATH := /glade/u/apps/ch/opt/pio/2.2/mpt/2.15f/intel/17.0.1/lib + +INC_NETCDF := $(NETCDF_PATH)/include +LIB_NETCDF := $(NETCDF_PATH)/lib + +#LIB_PNETCDF := $(PNETCDF_PATH)/lib +#LIB_MPI := $(IMPILIBDIR) + +INCLDIR := $(INCLDIR) -I$(INC_NETCDF) +#SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff -L$(LIB_PNETCDF) -lpnetcdf -lgptl +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.gaea_intel b/configuration/scripts/machines/env.gaea_intel new file mode 100755 index 000000000..d143270d7 --- /dev/null +++ b/configuration/scripts/machines/env.gaea_intel @@ -0,0 +1,34 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source /lustre/f2/pdata/esrl/gsd/contrib/lua-5.1.4.9/init/init_lmod.csh +#module list +module purge +module load intel +module load cray-mpich +module load cray-netcdf +module load PrgEnv-intel/6.0.5 +module list + +endif + +setenv ICE_MACHINE_MACHNAME gaea +setenv ICE_MACHINE_MACHINFO "Cray Intel SkyLake 6148" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort 18.0.5 20180823, cray-mpich, cray-netcdf" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR $HOME/scratch/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /ncrc/home1/Robert.Grumbine/rgdev/CICE_INPUTDATA +setenv ICE_MACHINE_BASELINE $HOME/scratch/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_TPNODE 40 +setenv ICE_MACHINE_ACCT P0000000 +setenv ICE_MACHINE_QUEUE "normal" +setenv ICE_MACHINE_BLDTHRDS 1 +setenv ICE_MACHINE_QSTAT "squeue --jobs=" From 0ccdea1cf6bf8ea4337e2a13aa953918297a4ab6 Mon Sep 17 00:00:00 2001 From: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Thu, 5 Aug 2021 20:52:55 +0200 Subject: [PATCH 05/15] Bug fixed 1d evp (#568) * Initialization of global HTE and HTN arrays with ghost cells on master task to avoid gathering constant arrays when running EVP 1D implementation. This solves issue with departure errors resulting from erroneous initialization of full land blocks in EVP 1D gathering. Correct initialization of remaining variables for full land blocks in EVP 1D gathering. * Reverted configuration/scripts/cice.batch.csh to resolve bad auto merge of file. Machine 'freya' was double in file. * Spell error corrected (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588484794). * Redundant initializations to default values removed (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588475352). @mhrib questions to default value settings removed. * Subroutine primary_grid_lengths_global_ext moved from ice_grid module to MPI and serial implementations of ice_boundary modules (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588472194). Please note duplication of subroutine. * Added 1d solver to be fully integrated. Removed kevp=102 bypass. Clean up. Changed namelist parameter kevp to evp_algorithm * General cleanup of ice_dyn_evp_1d module (https://github.com/CICE-Consortium/CICE/pull/568#issuecomment-789275054 and https://github.com/CICE-Consortium/CICE/pull/568#issuecomment-800886045) * Modified documentation in order to comply with modifications of evp 1d * Uncommenting of numainit parallelization removed and domp_init moved before numainit to ensure correct initialization. Additional cleanup of code. * renamed set_nml.evp_algorithm to set_nml.evp1d added test to base test * rm set_nml.kevp102 * Naming of variable se is not logical. Changed to sse which is the same as the global variable * Alignment of NUMA-aware array splitting between threads * Initialization of global HTE and HTN arrays with ghost cells on master task to avoid gathering constant arrays when running EVP 1D implementation. This solves issue with departure errors resulting from erroneous initialization of full land blocks in EVP 1D gathering. Correct initialization of remaining variables for full land blocks in EVP 1D gathering. * Reverted configuration/scripts/cice.batch.csh to resolve bad auto merge of file. Machine 'freya' was double in file. * Spell error corrected (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588484794). * Redundant initializations to default values removed (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588475352). @mhrib questions to default value settings removed. * Subroutine primary_grid_lengths_global_ext moved from ice_grid module to MPI and serial implementations of ice_boundary modules (https://github.com/CICE-Consortium/CICE/pull/568#discussion_r588472194). Please note duplication of subroutine. * Added 1d solver to be fully integrated. Removed kevp=102 bypass. Clean up. Changed namelist parameter kevp to evp_algorithm * General cleanup of ice_dyn_evp_1d module (https://github.com/CICE-Consortium/CICE/pull/568#issuecomment-789275054 and https://github.com/CICE-Consortium/CICE/pull/568#issuecomment-800886045) * Modified documentation in order to comply with modifications of evp 1d * Uncommenting of numainit parallelization removed and domp_init moved before numainit to ensure correct initialization. Additional cleanup of code. * renamed set_nml.evp_algorithm to set_nml.evp1d added test to base test * rm set_nml.kevp102 * Naming of variable se is not logical. Changed to sse which is the same as the global variable * Alignment of NUMA-aware array splitting between threads * Fix bad scaling of calculation of tinyarea. Different order of multiplication causes small differences in result * Fix evp 1d masking issues - There are relatively rare cases/gridcells where stress (tmask) and stepu (umask) are advanced without the other. The 1d evp implementation was not addressing this issue, so skiptcell was added to the 1d evp (similar to skipucell) to mask out cells separately for stress and stepu. This fixed a few non bit-for-bit cases in testing. - Cleaned up some indentation and other minor issues in 1d evp. - Updated the evp_algorithm log output in ice_init. * Some minor revisions in the documentation as suggested by @apcraig (https://github.com/CICE-Consortium/CICE/pull/568#pullrequestreview-708951919) plus some additional minor spelling corrections. Co-authored-by: Stefan Rethmeier Co-authored-by: Till Rasmussen Co-authored-by: Stefan Rethmeier Co-authored-by: apcraig --- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 215 +- cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 | 3906 ++++++++--------- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 31 +- cicecore/cicedynB/general/ice_init.F90 | 45 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 133 +- .../comm/mpi/ice_gather_scatter.F90 | 2 +- .../comm/serial/ice_boundary.F90 | 133 +- .../comm/serial/ice_gather_scatter.F90 | 2 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 30 +- configuration/scripts/ice_in | 2 +- configuration/scripts/options/set_nml.alt04 | 2 +- configuration/scripts/options/set_nml.evp1d | 1 + configuration/scripts/options/set_nml.kevp102 | 1 - configuration/scripts/tests/base_suite.ts | 6 +- doc/source/developer_guide/dg_dynamics.rst | 38 +- doc/source/developer_guide/dg_forcing.rst | 2 +- doc/source/science_guide/sg_dynamics.rst | 171 +- doc/source/user_guide/ug_case_settings.rst | 4 +- 18 files changed, 2402 insertions(+), 2322 deletions(-) mode change 100644 => 100755 cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 mode change 100644 => 100755 cicecore/cicedynB/dynamics/ice_dyn_shared.F90 create mode 100644 configuration/scripts/options/set_nml.evp1d delete mode 100644 configuration/scripts/options/set_nml.kevp102 diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index b796488b7..276c8bb79 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -34,7 +34,7 @@ module ice_dyn_evp use ice_kinds_mod - use ice_communicate, only: my_task + use ice_communicate, only: my_task, master_task use ice_constants, only: field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_vector use ice_constants, only: c0, p027, p055, p111, p166, & @@ -88,14 +88,14 @@ subroutine evp (dt) stress12_1, stress12_2, stress12_3, stress12_4 use ice_grid, only: tmask, umask, dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & tarear, uarear, tinyarea, to_ugrid, t2ugrid_vector, u2tgrid_vector, & - grid_type, HTE, HTN + grid_type use ice_state, only: aice, vice, vsno, uvel, vvel, divu, shear, & aice_init, aice0, aicen, vicen, strength use ice_timers, only: timer_dynamics, timer_bound, & ice_timer_start, ice_timer_stop, timer_evp_1d, timer_evp_2d use ice_dyn_evp_1d, only: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_kernel, & ice_dyn_evp_1d_copyout - use ice_dyn_shared, only: kevp_kernel, stack_velocity_field, unstack_velocity_field + use ice_dyn_shared, only: evp_algorithm, stack_velocity_field, unstack_velocity_field real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -331,7 +331,7 @@ subroutine evp (dt) if (seabed_stress) then - !$OMP PARALLEL DO PRIVATE(iblk) + !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks if ( seabed_stress_method == 'LKD' ) then @@ -351,118 +351,115 @@ subroutine evp (dt) hwater(:,:,iblk), Tbu(:,:,iblk)) endif - enddo + enddo !$OMP END PARALLEL DO endif + call ice_timer_start(timer_evp_2d) - if (kevp_kernel > 0) then - if (first_time .and. my_task == 0) then - write(nu_diag,'(2a,i6)') subname,' Entering kevp_kernel version ',kevp_kernel - first_time = .false. - endif - if (trim(grid_type) == 'tripole') then - call abort_ice(trim(subname)//' Kernel not tested on tripole grid. Set kevp_kernel=0') - endif - call ice_dyn_evp_1d_copyin( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & - HTE,HTN, & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & - icetmask, iceumask, & - cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, & - umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,& - strength,uvel,vvel,dxt,dyt, & - stressp_1 ,stressp_2, stressp_3, stressp_4, & - stressm_1 ,stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4 ) - if (kevp_kernel == 2) then - call ice_timer_start(timer_evp_1d) - call ice_dyn_evp_1d_kernel() - call ice_timer_stop(timer_evp_1d) -!v1 else if (kevp_kernel == 1) then -!v1 call evp_kernel_v1() - else - if (my_task == 0) write(nu_diag,*) subname,' ERROR: kevp_kernel = ',kevp_kernel - call abort_ice(subname//' kevp_kernel not supported.') - endif - call ice_dyn_evp_1d_copyout( & - nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,& -!strocn uvel,vvel, strocnx,strocny, strintx,strinty, & - uvel,vvel, strintx,strinty, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear,taubx,tauby ) - - else ! kevp_kernel == 0 (Standard CICE) - - do ksub = 1,ndte ! subcycling - - !----------------------------------------------------------------- - ! stress tensor equation, total surface stress - !----------------------------------------------------------------- - - !$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp) - do iblk = 1, nblocks -! if (trim(yield_curve) == 'ellipse') then - call stress (nx_block, ny_block, & - ksub, icellt(iblk), & - indxti (:,iblk), indxtj (:,iblk), & - uvel (:,:,iblk), vvel (:,:,iblk), & - dxt (:,:,iblk), dyt (:,:,iblk), & - dxhy (:,:,iblk), dyhx (:,:,iblk), & - cxp (:,:,iblk), cyp (:,:,iblk), & - cxm (:,:,iblk), cym (:,:,iblk), & - tarear (:,:,iblk), tinyarea (:,:,iblk), & - strength (:,:,iblk), & - stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), & - stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), & - stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), & - stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), & - stress12_1(:,:,iblk), stress12_2(:,:,iblk), & - stress12_3(:,:,iblk), stress12_4(:,:,iblk), & - shear (:,:,iblk), divu (:,:,iblk), & - rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & - strtmp (:,:,:) ) -! endif ! yield_curve - - !----------------------------------------------------------------- - ! momentum equation - !----------------------------------------------------------------- - - call stepu (nx_block, ny_block, & - icellu (iblk), Cdn_ocn (:,:,iblk), & - indxui (:,iblk), indxuj (:,iblk), & - ksub, & - aiu (:,:,iblk), strtmp (:,:,:), & - uocn (:,:,iblk), vocn (:,:,iblk), & - waterx (:,:,iblk), watery (:,:,iblk), & - forcex (:,:,iblk), forcey (:,:,iblk), & - umassdti (:,:,iblk), fm (:,:,iblk), & - uarear (:,:,iblk), & - strintx (:,:,iblk), strinty (:,:,iblk), & - taubx (:,:,iblk), tauby (:,:,iblk), & - uvel_init(:,:,iblk), vvel_init(:,:,iblk),& - uvel (:,:,iblk), vvel (:,:,iblk), & - Tbu (:,:,iblk)) - enddo - !$TCXOMP END PARALLEL DO + if (evp_algorithm == "shared_mem_1d" ) then - call stack_velocity_field(uvel, vvel, fld2) - call ice_timer_start(timer_bound) - if (maskhalo_dyn) then - call ice_HaloUpdate (fld2, halo_info_mask, & - field_loc_NEcorner, field_type_vector) - else - call ice_HaloUpdate (fld2, halo_info, & - field_loc_NEcorner, field_type_vector) + if (first_time .and. my_task == master_task) then + write(nu_diag,'(3a)') subname,' Entering evp_algorithm version ',evp_algorithm + first_time = .false. endif - call ice_timer_stop(timer_bound) - call unstack_velocity_field(fld2, uvel, vvel) + if (trim(grid_type) == 'tripole') then + call abort_ice(trim(subname)//' & + & Kernel not tested on tripole grid. Set evp_algorithm=standard_2d') + endif + + call ice_dyn_evp_1d_copyin( & + nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost, & + icetmask, iceumask, & + cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu, & + umassdti,fm,uarear,tarear,strintx,strinty,uvel_init,vvel_init,& + strength,uvel,vvel,dxt,dyt, & + stressp_1 ,stressp_2, stressp_3, stressp_4, & + stressm_1 ,stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4 ) + call ice_timer_start(timer_evp_1d) + call ice_dyn_evp_1d_kernel() + call ice_timer_stop(timer_evp_1d) + call ice_dyn_evp_1d_copyout( & + nx_block,ny_block,nblocks,nx_global+2*nghost,ny_global+2*nghost,& +!strocn uvel,vvel, strocnx,strocny, strintx,strinty, & + uvel,vvel, strintx,strinty, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4, & + divu,rdg_conv,rdg_shear,shear,taubx,tauby ) + + else ! evp_algorithm == standard_2d (Standard CICE) + + do ksub = 1,ndte ! subcycling + + !----------------------------------------------------------------- + ! stress tensor equation, total surface stress + !----------------------------------------------------------------- + + !$TCXOMP PARALLEL DO PRIVATE(iblk,strtmp) + do iblk = 1, nblocks + +! if (trim(yield_curve) == 'ellipse') then + call stress (nx_block, ny_block, & + ksub, icellt(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + dxhy (:,:,iblk), dyhx (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tarear (:,:,iblk), tinyarea (:,:,iblk), & + strength (:,:,iblk), & + stressp_1 (:,:,iblk), stressp_2 (:,:,iblk), & + stressp_3 (:,:,iblk), stressp_4 (:,:,iblk), & + stressm_1 (:,:,iblk), stressm_2 (:,:,iblk), & + stressm_3 (:,:,iblk), stressm_4 (:,:,iblk), & + stress12_1(:,:,iblk), stress12_2(:,:,iblk), & + stress12_3(:,:,iblk), stress12_4(:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv (:,:,iblk), rdg_shear (:,:,iblk), & + strtmp (:,:,:) ) +! endif ! yield_curve + + !----------------------------------------------------------------- + ! momentum equation + !----------------------------------------------------------------- + + call stepu (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + ksub, & + aiu (:,:,iblk), strtmp (:,:,:), & + uocn (:,:,iblk), vocn (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,iblk), & + umassdti (:,:,iblk), fm (:,:,iblk), & + uarear (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + uvel_init(:,:,iblk), vvel_init(:,:,iblk),& + uvel (:,:,iblk), vvel (:,:,iblk), & + Tbu (:,:,iblk)) + + enddo + !$TCXOMP END PARALLEL DO + + call stack_velocity_field(uvel, vvel, fld2) + call ice_timer_start(timer_bound) + if (maskhalo_dyn) then + call ice_HaloUpdate (fld2, halo_info_mask, & + field_loc_NEcorner, field_type_vector) + else + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) + endif + call ice_timer_stop(timer_bound) + call unstack_velocity_field(fld2, uvel, vvel) - enddo ! subcycling - endif ! kevp_kernel + enddo ! subcycling + endif ! evp_algorithm + call ice_timer_stop(timer_evp_2d) deallocate(fld2) diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 old mode 100644 new mode 100755 index 78469cc86..c691453cb --- a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 @@ -1,2135 +1,1941 @@ -! ice_dyn_evp_1d +!======================================================================= ! -! Contained 3 Fortran modules, -! * dmi_omp -! * bench_v2 -! * ice_dyn_evp_1d -! These were merged into one module, ice_dyn_evp_1d to support some -! coupled build systems. +! Elastic-viscous-plastic sea ice dynamics model (1D implementations) +! Computes ice velocity and deformation ! -! Modules used for: -! * convert 2D arrays into 1D vectors -! * Do stress/stepu/halo_update interations -! * convert 1D vectors into 2D matrices -! -! Call from ice_dyn_evp.F90: -! call ice_dyn_evp_1d_copyin(...) -! call ice_dyn_evp_1d_kernel() -! call ice_dyn_evp_1d_copyout(...) -! -! * REAL4 internal version: -! mv evp_kernel1d.F90 evp_kernel1d_r8.F90 -! cat evp_kernel1d_r8.F90 | sed s/DBL_KIND/REAL_KIND/g > evp_kernel1d.F90 -! -! * !v1 : a) "dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea" input variables is replaced by -! "HTE,HTN"->"HTE,HTN,HTEm1,HTNm1" and variables are calculated in-line -! b) "waterx,watery" is calculated using existing input "uocn,vocn" -! -! Jacob Weismann Poulsen (JWP), Mads Hvid Ribergaard (MHRI), DMI -!=============================================================================== +! authors: Jacob Weismann Poulsen, DMI +! Mads Hvid Ribergaard, DMI -!=============================================================================== - -!-- One dimension representation of EVP 2D arrays used for EVP kernels module ice_dyn_evp_1d - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - - implicit none - private - public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, ice_dyn_evp_1d_kernel - - interface ice_dyn_evp_1d_copyin -! module procedure evp_copyin_v1 - module procedure evp_copyin_v2 - end interface - - interface ice_dyn_evp_1d_kernel -! module procedure evp_kernel_v1 - module procedure evp_kernel_v2 - end interface - - interface ice_dyn_evp_1d_copyout - module procedure evp_copyout - end interface - - interface convert_2d_1d -! module procedure convert_2d_1d_v1 - module procedure convert_2d_1d_v2 - end interface - - integer(kind=int_kind) :: & - NA_len, NAVEL_len - logical(kind=log_kind), dimension(:), allocatable :: & - skipucell - integer(kind=int_kind), dimension(:), allocatable :: & - ee,ne,se,nw,sw,sse,indi,indj,indij , halo_parent - real (kind=dbl_kind), dimension(:), allocatable :: & - cdn_ocn,aiu,uocn,vocn,forcex,forcey,Tbu,tarear, & - umassdti,fm,uarear,strintx,strinty,uvel_init,vvel_init - real (kind=dbl_kind), dimension(:), allocatable :: & - strength,uvel,vvel,dxt,dyt, & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear,taubx,tauby - real (kind=DBL_KIND), dimension(:), allocatable :: & - str1, str2, str3, str4, str5, str6, str7, str8 - real (kind=dbl_kind), dimension(:), allocatable :: & - HTE,HTN, & - HTEm1,HTNm1 - logical(kind=log_kind),parameter :: dbug = .false. - - -!--- dmi_omp --------------------------- - interface domp_get_domain - module procedure domp_get_domain_rlu - end interface - - INTEGER, PARAMETER :: JPIM = SELECTED_INT_KIND(9) - integer(int_kind) :: domp_iam, domp_nt + use ice_kinds_mod + use ice_fileunits, only : nu_diag + use ice_exit, only : abort_ice + use icepack_intfc, only : icepack_query_parameters + use icepack_intfc, only : icepack_warnings_flush, & + icepack_warnings_aborted + implicit none + private + public :: ice_dyn_evp_1d_copyin, ice_dyn_evp_1d_copyout, & + ice_dyn_evp_1d_kernel + + integer(kind=int_kind) :: NA_len, NAVEL_len, domp_iam, domp_nt #if defined (_OPENMP) - ! Please note, this constant will create a compiler info for a constant - ! expression in IF statements: - real(kind=dbl_kind) :: rdomp_iam, rdomp_nt - !$OMP THREADPRIVATE(domp_iam,domp_nt,rdomp_iam,rdomp_nt) + real(kind=dbl_kind) :: rdomp_iam, rdomp_nt + !$OMP THREADPRIVATE(domp_iam, domp_nt, rdomp_iam, rdomp_nt) #endif -!--- dmi_omp --------------------------- - -!--- bench_v2 -------------------------- - interface evp1d_stress - module procedure stress_i - module procedure stress_l - end interface - interface evp1d_stepu - module procedure stepu_iter - module procedure stepu_last - end interface -!--- bench_v2 -------------------------- + logical(kind=log_kind), dimension(:), allocatable :: skiptcell, skipucell + integer(kind=int_kind), dimension(:), allocatable :: ee, ne, se, & + nw, sw, sse, indi, indj, indij, halo_parent + real(kind=dbl_kind), dimension(:), allocatable :: cdn_ocn, aiu, & + uocn, vocn, forcex, forcey, Tbu, tarear, umassdti, fm, uarear, & + strintx, strinty, uvel_init, vvel_init, strength, uvel, vvel, & + dxt, dyt, stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4, divu, rdg_conv, rdg_shear, shear, taubx, & + tauby, str1, str2, str3, str4, str5, str6, str7, str8, HTE, HTN, & + HTEm1, HTNm1 + integer, parameter :: JPIM = selected_int_kind(9) + + interface evp1d_stress + module procedure stress_iter + module procedure stress_last + end interface + + interface evp1d_stepu + module procedure stepu_iter + module procedure stepu_last + end interface + +!======================================================================= + +contains + +!======================================================================= + + subroutine domp_init +#if defined (_OPENMP) - contains + use omp_lib, only : omp_get_thread_num, omp_get_num_threads +#endif -!=============================================================================== -!former module dmi_omp + implicit none - subroutine domp_init(nt_out) + character(len=*), parameter :: subname = '(domp_init)' + !$OMP PARALLEL DEFAULT(none) #if defined (_OPENMP) - use omp_lib, only : omp_get_thread_num, omp_get_num_threads + domp_iam = omp_get_thread_num() + rdomp_iam = real(domp_iam, dbl_kind) + domp_nt = omp_get_num_threads() + rdomp_nt = real(domp_nt, dbl_kind) +#else + domp_iam = 0 + domp_nt = 1 #endif + !$OMP END PARALLEL - integer(int_kind), intent(out) :: nt_out + end subroutine domp_init - character(len=*), parameter :: subname = '(domp_init)' - !--------------------------------------- +!======================================================================= - !$OMP PARALLEL DEFAULT(none) + subroutine domp_get_domain(lower, upper, d_lower, d_upper) #if defined (_OPENMP) - domp_iam = omp_get_thread_num() - rdomp_iam = real(domp_iam,dbl_kind) - domp_nt = omp_get_num_threads() - rdomp_nt = real(domp_nt,dbl_kind) -#else - domp_iam = 0 - domp_nt = 1 -#endif - !$OMP END PARALLEL - - if (dbug) then -#if defined (_OPENACC) - write(nu_diag,'(2a)') subname,' Build with openACC support' -!#elif defined (_OPENMP) -! write(nu_diag,'(2a)') subname,' Build with openMP support' -!#else -! write(nu_diag,'(2a)') subname,' Build without openMP and openACC support' + + use omp_lib, only : omp_in_parallel + use ice_constants, only : p5 #endif - !- echo #threads: - if (domp_nt > 1) then - write(nu_diag,'(2a,i5,a)') subname,' Running openMP with ', domp_nt, ' threads' - else + implicit none + + integer(kind=JPIM), intent(in) :: lower, upper + integer(kind=JPIM), intent(out) :: d_lower, d_upper + + ! local variables #if defined (_OPENMP) - write(nu_diag,'(2a)') subname,' Running openMP with a single thread' -#else - write(nu_diag,'(2a)') subname,' Running without openMP' -#endif - endif - endif - !- return value of #threads: - nt_out = domp_nt + real(kind=dbl_kind) :: dlen +#endif - end subroutine domp_init - -!---------------------------------------------------------------------------- + character(len=*), parameter :: subname = '(domp_get_domain)' - subroutine domp_get_domain_rlu(lower,upper,d_lower,d_upper) + ! proper action in "null" case + if (upper <= 0 .or. upper < lower) then + d_lower = 0 + d_upper = -1 + return + end if + ! proper action in serial case + d_lower = lower + d_upper = upper #if defined (_OPENMP) - use omp_lib, only : omp_in_parallel - use ice_constants, only: p5 + + if (omp_in_parallel()) then + dlen = real((upper - lower + 1), dbl_kind) + d_lower = lower + floor(((rdomp_iam * dlen + p5) / rdomp_nt), JPIM) + d_upper = lower - 1 + floor(((rdomp_iam * dlen + dlen + p5) / rdomp_nt), JPIM) + end if #endif - integer(KIND=JPIM), intent(in) :: lower,upper - integer(KIND=JPIM), intent(out) :: d_lower,d_upper + end subroutine domp_get_domain + +!======================================================================= + + subroutine stress_iter(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxt, & + dyt, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & + stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & + stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & + str2, str3, str4, str5, str6, str7, str8, skiptcell) + + use ice_kinds_mod + use ice_constants, only : p027, p055, p111, p166, p222, p25, & + p333, p5, c1p5, c1 + use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + ee, ne, se + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, hte, htn, htem1, htnm1 + logical(kind=log_kind), intent(in), dimension(:) :: skiptcell + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4 + real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & + str1, str2, str3, str4, str5, str6, str7, str8 + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: puny, divune, divunw, divuse, divusw, & + tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & + shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & + c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & + ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & + ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & + ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & + csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & + csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & + strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & + cxm, cym, tinyarea,tmparea + + character(len=*), parameter :: subname = '(stress_iter)' + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if -#if defined (_OPENMP) - !-- local variables - real(kind=dbl_kind) :: dlen +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee, ne, se, strength, uvel, vvel, dxt, dyt, hte, & + !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & + !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & + !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & + !$acc stress12_2, stress12_3, stress12_4, skiptcell) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu #endif - character(len=*), parameter :: subname = '(domp_get_domain_rlu)' - !--------------------------------------- + if (skiptcell(iw)) cycle + + tmparea = dxt(iw) * dyt(iw) ! necessary to split calc of tinyarea. Otherwize not binary identical + tinyarea = puny * tmparea + dxhy = p5 * (hte(iw) - htem1(iw)) + dyhx = p5 * (htn(iw) - htnm1(iw)) + cxp = c1p5 * htn(iw) - p5 * htnm1(iw) + cyp = c1p5 * hte(iw) - p5 * htem1(iw) + cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) + cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) + + !-------------------------------------------------------------- + ! strain rates + ! NOTE: these are actually strain rates * area (m^2/s) + !-------------------------------------------------------------- + + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + tmp_uvel_ee = uvel(ee(iw)) + + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ne = vvel(ne(iw)) + ! divergence = e_11 + e_22 + divune = cyp * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxp * vvel(iw) - dxt(iw) * tmp_vvel_se + divunw = cym * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxp * tmp_vvel_ee - dxt(iw) * tmp_vvel_ne + divusw = cym * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxm * tmp_vvel_ne + dxt(iw) * tmp_vvel_ee + divuse = cyp * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxm * tmp_vvel_se + dxt(iw) * vvel(iw) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxm * vvel(iw) + dxt(iw) * tmp_vvel_se + tensionnw = -cyp * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxm * tmp_vvel_ee + dxt(iw) * tmp_vvel_ne + tensionsw = -cyp * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxp * tmp_vvel_ne - dxt(iw) * tmp_vvel_ee + tensionse = -cym * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxp * tmp_vvel_se - dxt(iw) * vvel(iw) + + ! shearing strain rate = 2 * e_12 + shearne = -cym * vvel(iw) - dyt(iw) * tmp_vvel_ee & + - cxm * uvel(iw) - dxt(iw) * tmp_uvel_se + shearnw = -cyp * tmp_vvel_ee + dyt(iw) * vvel(iw) & + - cxm * tmp_uvel_ee - dxt(iw) * tmp_uvel_ne + shearsw = -cyp * tmp_vvel_ne + dyt(iw) * tmp_vvel_se & + - cxp * tmp_uvel_ne + dxt(iw) * tmp_uvel_ee + shearse = -cym * tmp_vvel_se - dyt(iw) * tmp_vvel_ne & + - cxp * tmp_uvel_se + dxt(iw) * uvel(iw) + + ! Delta (in the denominator of zeta and eta) + Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) + + !-------------------------------------------------------------- + ! replacement pressure/Delta (kg/s) + ! save replacement pressure for principal stress calculation + !-------------------------------------------------------------- + + c0ne = strength(iw) / max(Deltane, tinyarea) + c0nw = strength(iw) / max(Deltanw, tinyarea) + c0sw = strength(iw) / max(Deltasw, tinyarea) + c0se = strength(iw) / max(Deltase, tinyarea) + + c1ne = c0ne * arlx1i + c1nw = c0nw * arlx1i + c1sw = c0sw * arlx1i + c1se = c0se * arlx1i + + c0ne = c1ne * ecci + c0nw = c1nw * ecci + c0sw = c1sw * ecci + c0se = c1se * ecci + + !-------------------------------------------------------------- + ! the stresses (kg/s^2) + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !-------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & + + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & + + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & + + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & + + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 + + !-------------------------------------------------------------- + ! combinations of the stresses for the momentum equation + ! (kg/s^2) + !-------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 + ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 + ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 + ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 + + csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) + csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) + csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) + csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) + + csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) + csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) + csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) + csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) + + csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) + csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) + csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) + csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) + + str12ew = p5 * dxt(iw) * (p333 * ssig12e + p166 * ssig12w) + str12we = p5 * dxt(iw) * (p333 * ssig12w + p166 * ssig12e) + str12ns = p5 * dyt(iw) * (p333 * ssig12n + p166 * ssig12s) + str12sn = p5 * dyt(iw) * (p333 * ssig12s + p166 * ssig12n) + + !-------------------------------------------------------------- + ! for dF/dx (u momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dyt(iw) * (p333 * ssigpn + p166 * ssigps) + strm_tmp = p25 * dyt(iw) * (p333 * ssigmn + p166 * ssigms) + + ! northeast (i,j) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy * (-csigpne + csigmne) + dyhx * csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw + + strp_tmp = p25 * dyt(iw) * (p333 * ssigps + p166 * ssigpn) + strm_tmp = p25 * dyt(iw) * (p333 * ssigms + p166 * ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy * (-csigpse + csigmse) + dyhx * csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw + + !-------------------------------------------------------------- + ! for dF/dy (v momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpe + p166 * ssigpw) + strm_tmp = p25 * dxt(iw) * (p333 * ssigme + p166 * ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx * (csigpne + csigmne) + dxhy * csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx * (csigpse + csigmse) + dxhy * csig12se + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpw + p166 * ssigpe) + strm_tmp = p25 * dxt(iw) * (p333 * ssigmw + p166 * ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw + + end do +#ifdef _OPENACC + !$acc end parallel +#endif - ! proper action in "null" cases: - if (upper <= 0 .or. upper < lower) then - d_lower = 0 - d_upper = -1 - return - endif + end subroutine stress_iter + +!======================================================================= + + subroutine stress_last(NA_len, ee, ne, se, lb, ub, uvel, vvel, dxt, & + dyt, hte, htn, htem1, htnm1, strength, stressp_1, stressp_2, & + stressp_3, stressp_4, stressm_1, stressm_2, stressm_3, & + stressm_4, stress12_1, stress12_2, stress12_3, stress12_4, str1, & + str2, str3, str4, str5, str6, str7, str8, skiptcell, tarear, divu, & + rdg_conv, rdg_shear, shear) + + use ice_kinds_mod + use ice_constants, only : p027, p055, p111, p166, p222, p25, & + p333, p5, c1p5, c1, c0 + use ice_dyn_shared, only : ecci, denom1, arlx1i, Ktens, revp + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + ee, ne, se + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + strength, uvel, vvel, dxt, dyt, hte, htn, htem1, htnm1, tarear + logical(kind=log_kind), intent(in), dimension(:) :: skiptcell + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, stress12_2, & + stress12_3, stress12_4 + real(kind=dbl_kind), dimension(:), intent(out), contiguous :: & + str1, str2, str3, str4, str5, str6, str7, str8, divu, & + rdg_conv, rdg_shear, shear + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: puny, divune, divunw, divuse, divusw, & + tensionne, tensionnw, tensionse, tensionsw, shearne, shearnw, & + shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw, c0ne, & + c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw, ssigpn, ssigps, & + ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw, ssig12n, & + ssig12s, ssig12e, ssig12w, ssigp1, ssigp2, ssigm1, ssigm2, & + ssig121, ssig122, csigpne, csigpnw, csigpse, csigpsw, & + csigmne, csigmnw, csigmse, csigmsw, csig12ne, csig12nw, & + csig12se, csig12sw, str12ew, str12we, str12ns, str12sn, & + strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & + tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se, dxhy, dyhx, cxp, cyp, & + cxm, cym, tinyarea, tmparea + + character(len=*), parameter :: subname = '(stress_last)' + + call icepack_query_parameters(puny_out=puny) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if - ! proper action in serial sections - d_lower = lower - d_upper = upper +#ifdef _OPENACC + !$acc parallel & + !$acc present(ee, ne, se, strength, uvel, vvel, dxt, dyt, hte, & + !$acc htn, htem1, htnm1, str1, str2, str3, str4, str5, str6, & + !$acc str7, str8, stressp_1, stressp_2, stressp_3, stressp_4, & + !$acc stressm_1, stressm_2, stressm_3, stressm_4, stress12_1, & + !$acc stress12_2, stress12_3, stress12_4, tarear, divu, & + !$acc rdg_conv, rdg_shear, shear, skiptcell) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu +#endif -#if defined (_OPENMP) - if (omp_in_parallel()) then - dlen = real(upper-lower+1, dbl_kind) - d_lower = lower + floor((rdomp_iam*dlen+p5)/rdomp_nt, JPIM) - d_upper = lower -1 + floor((rdomp_iam*dlen+dlen+p5)/rdomp_nt, JPIM) - endif + if (skiptcell(iw)) cycle + + tmparea = dxt(iw) * dyt(iw) ! necessary to split calc of tinyarea. Otherwize not binary identical + tinyarea = puny * tmparea + dxhy = p5 * (hte(iw) - htem1(iw)) + dyhx = p5 * (htn(iw) - htnm1(iw)) + cxp = c1p5 * htn(iw) - p5 * htnm1(iw) + cyp = c1p5 * hte(iw) - p5 * htem1(iw) + cxm = -(c1p5 * htnm1(iw) - p5 * htn(iw)) + cym = -(c1p5 * htem1(iw) - p5 * hte(iw)) + + !-------------------------------------------------------------- + ! strain rates + ! NOTE: these are actually strain rates * area (m^2/s) + !-------------------------------------------------------------- + + tmp_uvel_ne = uvel(ne(iw)) + tmp_uvel_se = uvel(se(iw)) + tmp_uvel_ee = uvel(ee(iw)) + + tmp_vvel_ee = vvel(ee(iw)) + tmp_vvel_se = vvel(se(iw)) + tmp_vvel_ne = vvel(ne(iw)) + + ! divergence = e_11 + e_22 + divune = cyp * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxp * vvel(iw) - dxt(iw) * tmp_vvel_se + divunw = cym * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxp * tmp_vvel_ee - dxt(iw) * tmp_vvel_ne + divusw = cym * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxm * tmp_vvel_ne + dxt(iw) * tmp_vvel_ee + divuse = cyp * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxm * tmp_vvel_se + dxt(iw) * vvel(iw) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym * uvel(iw) - dyt(iw) * tmp_uvel_ee & + + cxm * vvel(iw) + dxt(iw) * tmp_vvel_se + tensionnw = -cyp * tmp_uvel_ee + dyt(iw) * uvel(iw) & + + cxm * tmp_vvel_ee + dxt(iw) * tmp_vvel_ne + tensionsw = -cyp * tmp_uvel_ne + dyt(iw) * tmp_uvel_se & + + cxp * tmp_vvel_ne - dxt(iw) * tmp_vvel_ee + tensionse = -cym * tmp_uvel_se - dyt(iw) * tmp_uvel_ne & + + cxp * tmp_vvel_se - dxt(iw) * vvel(iw) + + ! shearing strain rate = 2 * e_12 + shearne = -cym * vvel(iw) - dyt(iw) * tmp_vvel_ee & + - cxm * uvel(iw) - dxt(iw) * tmp_uvel_se + shearnw = -cyp * tmp_vvel_ee + dyt(iw) * vvel(iw) & + - cxm * tmp_uvel_ee - dxt(iw) * tmp_uvel_ne + shearsw = -cyp * tmp_vvel_ne + dyt(iw) * tmp_vvel_se & + - cxp * tmp_uvel_ne + dxt(iw) * tmp_uvel_ee + shearse = -cym * tmp_vvel_se - dyt(iw) * tmp_vvel_ne & + - cxp * tmp_uvel_se + dxt(iw) * uvel(iw) + + ! Delta (in the denominator of zeta and eta) + Deltane = sqrt(divune**2 + ecci * (tensionne**2 + shearne**2)) + Deltanw = sqrt(divunw**2 + ecci * (tensionnw**2 + shearnw**2)) + Deltasw = sqrt(divusw**2 + ecci * (tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci * (tensionse**2 + shearse**2)) + + !-------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical + ! redistribution + !-------------------------------------------------------------- + + divu(iw) = p25 * (divune + divunw + divuse + divusw) * tarear(iw) + rdg_conv(iw) = -min(divu(iw), c0) ! TODO: Could move outside the entire kernel + rdg_shear(iw) = p5 * (p25 * (Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) - abs(divu(iw))) + + ! diagnostic only + ! shear = sqrt(tension**2 + shearing**2) + shear(iw) = p25 * tarear(iw) * sqrt((tensionne + tensionnw + tensionse + tensionsw)**2 & + + (shearne + shearnw + shearse + shearsw)**2) + + !-------------------------------------------------------------- + ! replacement pressure/Delta (kg/s) + ! save replacement pressure for principal stress calculation + !-------------------------------------------------------------- + + c0ne = strength(iw) / max(Deltane, tinyarea) + c0nw = strength(iw) / max(Deltanw, tinyarea) + c0sw = strength(iw) / max(Deltasw, tinyarea) + c0se = strength(iw) / max(Deltase, tinyarea) + + c1ne = c0ne * arlx1i + c1nw = c0nw * arlx1i + c1sw = c0sw * arlx1i + c1se = c0se * arlx1i + + c0ne = c1ne * ecci + c0nw = c1nw * ecci + c0sw = c1sw * ecci + c0se = c1se * ecci + + !-------------------------------------------------------------- + ! the stresses (kg/s^2) + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !-------------------------------------------------------------- + + stressp_1(iw) = (stressp_1(iw) * (c1 - arlx1i * revp) & + + c1ne * (divune * (c1 + Ktens) - Deltane * (c1 - Ktens))) * denom1 + stressp_2(iw) = (stressp_2(iw) * (c1 - arlx1i * revp) & + + c1nw * (divunw * (c1 + Ktens) - Deltanw * (c1 - Ktens))) * denom1 + stressp_3(iw) = (stressp_3(iw) * (c1 - arlx1i * revp) & + + c1sw * (divusw * (c1 + Ktens) - Deltasw * (c1 - Ktens))) * denom1 + stressp_4(iw) = (stressp_4(iw) * (c1 - arlx1i * revp) & + + c1se * (divuse * (c1 + Ktens) - Deltase * (c1 - Ktens))) * denom1 + + stressm_1(iw) = (stressm_1(iw) * (c1 - arlx1i * revp) + c0ne * tensionne * (c1 + Ktens)) * denom1 + stressm_2(iw) = (stressm_2(iw) * (c1 - arlx1i * revp) + c0nw * tensionnw * (c1 + Ktens)) * denom1 + stressm_3(iw) = (stressm_3(iw) * (c1 - arlx1i * revp) + c0sw * tensionsw * (c1 + Ktens)) * denom1 + stressm_4(iw) = (stressm_4(iw) * (c1 - arlx1i * revp) + c0se * tensionse * (c1 + Ktens)) * denom1 + + stress12_1(iw) = (stress12_1(iw) * (c1 - arlx1i * revp) + c0ne * shearne * p5 * (c1 + Ktens)) * denom1 + stress12_2(iw) = (stress12_2(iw) * (c1 - arlx1i * revp) + c0nw * shearnw * p5 * (c1 + Ktens)) * denom1 + stress12_3(iw) = (stress12_3(iw) * (c1 - arlx1i * revp) + c0sw * shearsw * p5 * (c1 + Ktens)) * denom1 + stress12_4(iw) = (stress12_4(iw) * (c1 - arlx1i * revp) + c0se * shearse * p5 * (c1 + Ktens)) * denom1 + + !-------------------------------------------------------------- + ! combinations of the stresses for the momentum equation + ! (kg/s^2) + !-------------------------------------------------------------- + + ssigpn = stressp_1(iw) + stressp_2(iw) + ssigps = stressp_3(iw) + stressp_4(iw) + ssigpe = stressp_1(iw) + stressp_4(iw) + ssigpw = stressp_2(iw) + stressp_3(iw) + ssigp1 = (stressp_1(iw) + stressp_3(iw)) * p055 + ssigp2 = (stressp_2(iw) + stressp_4(iw)) * p055 + + ssigmn = stressm_1(iw) + stressm_2(iw) + ssigms = stressm_3(iw) + stressm_4(iw) + ssigme = stressm_1(iw) + stressm_4(iw) + ssigmw = stressm_2(iw) + stressm_3(iw) + ssigm1 = (stressm_1(iw) + stressm_3(iw)) * p055 + ssigm2 = (stressm_2(iw) + stressm_4(iw)) * p055 + + ssig12n = stress12_1(iw) + stress12_2(iw) + ssig12s = stress12_3(iw) + stress12_4(iw) + ssig12e = stress12_1(iw) + stress12_4(iw) + ssig12w = stress12_2(iw) + stress12_3(iw) + ssig121 = (stress12_1(iw) + stress12_3(iw)) * p111 + ssig122 = (stress12_2(iw) + stress12_4(iw)) * p111 + + csigpne = p111 * stressp_1(iw) + ssigp2 + p027 * stressp_3(iw) + csigpnw = p111 * stressp_2(iw) + ssigp1 + p027 * stressp_4(iw) + csigpsw = p111 * stressp_3(iw) + ssigp2 + p027 * stressp_1(iw) + csigpse = p111 * stressp_4(iw) + ssigp1 + p027 * stressp_2(iw) + + csigmne = p111 * stressm_1(iw) + ssigm2 + p027 * stressm_3(iw) + csigmnw = p111 * stressm_2(iw) + ssigm1 + p027 * stressm_4(iw) + csigmsw = p111 * stressm_3(iw) + ssigm2 + p027 * stressm_1(iw) + csigmse = p111 * stressm_4(iw) + ssigm1 + p027 * stressm_2(iw) + + csig12ne = p222 * stress12_1(iw) + ssig122 + p055 * stress12_3(iw) + csig12nw = p222 * stress12_2(iw) + ssig121 + p055 * stress12_4(iw) + csig12sw = p222 * stress12_3(iw) + ssig122 + p055 * stress12_1(iw) + csig12se = p222 * stress12_4(iw) + ssig121 + p055 * stress12_2(iw) + + str12ew = p5 * dxt(iw) * (p333 * ssig12e + p166 * ssig12w) + str12we = p5 * dxt(iw) * (p333 * ssig12w + p166 * ssig12e) + str12ns = p5 * dyt(iw) * (p333 * ssig12n + p166 * ssig12s) + str12sn = p5 * dyt(iw) * (p333 * ssig12s + p166 * ssig12n) + + !-------------------------------------------------------------- + ! for dF/dx (u momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dyt(iw) * (p333 * ssigpn + p166 * ssigps) + strm_tmp = p25 * dyt(iw) * (p333 * ssigmn + p166 * ssigms) + + ! northeast (i,j) + str1(iw) = -strp_tmp - strm_tmp - str12ew & + + dxhy * (-csigpne + csigmne) + dyhx * csig12ne + + ! northwest (i+1,j) + str2(iw) = strp_tmp + strm_tmp - str12we & + + dxhy * (-csigpnw + csigmnw) + dyhx * csig12nw + + strp_tmp = p25 * dyt(iw) * (p333 * ssigps + p166 * ssigpn) + strm_tmp = p25 * dyt(iw) * (p333 * ssigms + p166 * ssigmn) + + ! southeast (i,j+1) + str3(iw) = -strp_tmp - strm_tmp + str12ew & + + dxhy * (-csigpse + csigmse) + dyhx * csig12se + + ! southwest (i+1,j+1) + str4(iw) = strp_tmp + strm_tmp + str12we & + + dxhy * (-csigpsw + csigmsw) + dyhx * csig12sw + + !-------------------------------------------------------------- + ! for dF/dy (v momentum) + !-------------------------------------------------------------- + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpe + p166 * ssigpw) + strm_tmp = p25 * dxt(iw) * (p333 * ssigme + p166 * ssigmw) + + ! northeast (i,j) + str5(iw) = -strp_tmp + strm_tmp - str12ns & + - dyhx * (csigpne + csigmne) + dxhy * csig12ne + + ! southeast (i,j+1) + str6(iw) = strp_tmp - strm_tmp - str12sn & + - dyhx * (csigpse + csigmse) + dxhy * csig12se + + strp_tmp = p25 * dxt(iw) * (p333 * ssigpw + p166 * ssigpe) + strm_tmp = p25 * dxt(iw) * (p333 * ssigmw + p166 * ssigme) + + ! northwest (i+1,j) + str7(iw) = -strp_tmp + strm_tmp + str12ns & + - dyhx * (csigpnw + csigmnw) + dxhy * csig12nw + + ! southwest (i+1,j+1) + str8(iw) = strp_tmp - strm_tmp + str12sn & + - dyhx * (csigpsw + csigmsw) + dxhy * csig12sw + + end do +#ifdef _OPENACC + !$acc end parallel #endif - if (.false.) then - write(nu_diag,'(2a,i3,a,2i10)') subname,' openMP thread ', domp_iam, & - ' handles range: ', d_lower, d_upper - endif + end subroutine stress_last - end subroutine domp_get_domain_rlu +!======================================================================= -!---------------------------------------------------------------------------- + subroutine stepu_iter(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & + forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & + uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & + sw, sse, skipucell) - subroutine domp_get_thread_no (tnum) + use ice_kinds_mod + use ice_constants, only : c0, c1 + use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw - implicit none - integer(int_kind), intent(out) :: tnum - character(len=*), parameter :: subname = '(domp_get_thread_no)' + implicit none - tnum = domp_iam + 1 + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + real(kind=dbl_kind), intent(in) :: rhow + logical(kind=log_kind), intent(in), dimension(:) :: skipucell + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + nw, sw, sse + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & + str6, str7, str8 + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel - end subroutine domp_get_thread_no + ! local variables -!---------------------------------------------------------------------------- + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & + cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & + tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery, & + tmp_strintx, tmp_strinty -!former end module dmi_omp + character(len=*), parameter :: subname = '(stepu_iter)' -!=============================================================================== +#ifdef _OPENACC + !$acc parallel & + !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & + !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & + !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & + !$acc vvel) + !$acc loop + do iw = 1, NA_len +#else + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu +#endif -!former module bench_v2 + if (skipucell(iw)) cycle -!---------------------------------------------------------------------------- + uold = uvel(iw) + vold = vvel(iw) - subroutine stress_i(NA_len, & - ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4,str1,str2,str3,str4,str5, & - str6,str7,str8) + vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) - use ice_kinds_mod - use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c1 - use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp + waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) + watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) - implicit none + taux = vrel * waterx + tauy = vrel * watery - integer (kind=int_kind), intent(in) :: NA_len - integer (kind=int_kind), intent(in) :: lb,ub - integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se - real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxt, dyt, & - hte,htn,htem1,htnm1 - real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & - stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 - real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - !-- local variables + cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: & - puny - real (kind=DBL_KIND) :: & - divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & - shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & - c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & - ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & - ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & - ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & - csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & - str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se - real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea - - character(len=*), parameter :: subname = '(stress_i)' - !--------------------------------------- + ab2 = cca**2 + ccb**2 - call icepack_query_parameters(puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt, & - !$acc hte, htn, htem1, htnm1, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8, & - !$acc stressp_1,stressp_2,stressp_3,stressp_4, & - !$acc stressm_1,stressm_2,stressm_3,stressm_4, & - !$acc stress12_1,stress12_2,stress12_3,stress12_4) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - tinyarea = puny*dxt(iw)*dyt(iw) - dxhy = p5*(hte(iw) - htem1(iw)) - dyhx = p5*(htn(iw) - htnm1(iw)) - cxp = c1p5*htn(iw) - p5*htnm1(iw) - cyp = c1p5*hte(iw) - p5*htem1(iw) - cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) - cym = -(c1p5*htem1(iw) - p5*hte(iw)) - - !----------------------------------------------------------------- - ! strain rates - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - ! divergence = e_11 + e_22 - tmp_uvel_ee = uvel(ee(iw)) - tmp_vvel_ee = vvel(ee(iw)) - - tmp_vvel_se = vvel(se(iw)) - tmp_uvel_se = uvel(se(iw)) - - ! ne - divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se - ! tension strain rate = e_11 - e_22 - tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se - ! shearing strain rate = 2*e_12 - shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & - - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se - ! Delta (in the denominator of zeta, eta) - Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) - - ! These two can move after ne block - ! - tmp_uvel_ne = uvel(ne(iw)) - tmp_vvel_ne = vvel(ne(iw)) - - ! nw - divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne - tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne - shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & - - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne - Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) - - ! sw - divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee - tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee - shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & - - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee - Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) - - ! se - divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) - tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) - shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & - - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) - Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) - - !----------------------------------------------------------------- - ! replacement pressure/Delta ! kg/s - ! save replacement pressure for principal stress calculation - !----------------------------------------------------------------- - c0ne = strength(iw)/max(Deltane,tinyarea) - c0nw = strength(iw)/max(Deltanw,tinyarea) - c0sw = strength(iw)/max(Deltasw,tinyarea) - c0se = strength(iw)/max(Deltase,tinyarea) - - c1ne = c0ne*arlx1i - c1nw = c0nw*arlx1i - c1sw = c0sw*arlx1i - c1se = c0se*arlx1i - - c0ne = c1ne*ecci - c0nw = c1nw*ecci - c0sw = c1sw*ecci - c0se = c1se*ecci - - !----------------------------------------------------------------- - ! the stresses ! kg/s^2 - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !----------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 - - !----------------------------------------------------------------- - ! combinations of the stresses for the momentum equation ! kg/s^2 - !----------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 - ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 - ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 - ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 - - csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) - csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) - csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) - csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) - - csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) - csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) - csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) - csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) - - csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) - csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) - csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) - csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) - - str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) - str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) - str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) - str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) - - !----------------------------------------------------------------- - ! for dF/dx (u momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) - strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) - - ! northeast (iw) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy*(-csigpne + csigmne) + dyhx*csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw - - strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) - strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy*(-csigpse + csigmse) + dyhx*csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw - - !----------------------------------------------------------------- - ! for dF/dy (v momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) - strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx*(csigpne + csigmne) + dxhy*csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx*(csigpse + csigmse) + dxhy*csig12se - - strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) - strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw - enddo -#ifdef _OPENACC - !$acc end parallel -#endif + tmp_strintx = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) + tmp_strinty = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) - end subroutine stress_i - -!---------------------------------------------------------------------------- - - subroutine stress_l(NA_len, tarear, & - ee,ne,se,lb,ub,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear, & - str1,str2,str3,str4,str5,str6,str7,str8 ) - - use ice_kinds_mod - use ice_constants, only: p027, p055, p111, p166, p222, p25, p333, p5, c1p5, c0, c1 - use ice_dyn_shared, only: ecci, denom1, arlx1i, Ktens, revp - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - integer (kind=int_kind), intent(in) :: lb,ub - integer (kind=int_kind), dimension(:), intent(in), contiguous :: ee,ne,se - real (kind=dbl_kind), dimension(:), intent(in), contiguous :: & - strength, uvel, vvel, dxt, dyt, tarear, & - hte,htn,htem1,htnm1 - real (kind=dbl_kind), dimension(:), intent(inout), contiguous :: & - stressp_1,stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & - stressm_3,stressm_4, stress12_1,stress12_2,stress12_3, stress12_4 - real (kind=DBL_KIND), dimension(:), intent(out), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real (kind=dbl_kind), dimension(:), intent(out), contiguous :: & - divu,rdg_conv,rdg_shear,shear - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: & - puny - real (kind=DBL_KIND) :: & - divune, divunw, divuse, divusw,tensionne, tensionnw, tensionse, tensionsw, & - shearne, shearnw, shearse, shearsw, Deltane, Deltanw, Deltase, Deltasw , & - c0ne, c0nw, c0se, c0sw, c1ne, c1nw, c1se, c1sw , & - ssigpn, ssigps, ssigpe, ssigpw, ssigmn, ssigms, ssigme, ssigmw , & - ssig12n, ssig12s, ssig12e, ssig12w, ssigp1, ssigp2,ssigm1, ssigm2,ssig121, & - ssig122, csigpne, csigpnw, csigpse, csigpsw,csigmne, csigmnw, csigmse , & - csigmsw, csig12ne, csig12nw, csig12se, csig12sw, str12ew, str12we,str12ns, & - str12sn, strp_tmp, strm_tmp, tmp_uvel_ee, tmp_vvel_se, tmp_vvel_ee, & - tmp_vvel_ne, tmp_uvel_ne, tmp_uvel_se - real (kind=DBL_KIND) :: dxhy,dyhx,cxp,cyp,cxm,cym,tinyarea - - character(len=*), parameter :: subname = '(stress_l)' - !--------------------------------------- - - call icepack_query_parameters(puny_out=puny) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + cc1 = tmp_strintx + forcex(iw) + taux & + + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) + cc2 = tmp_strinty + forcey(iw) + tauy & + + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) -#ifdef _OPENACC - !$acc parallel & - !$acc present(ee,ne,se,strength,uvel,vvel,dxt,dyt,tarear, & - !$acc hte,htn,htem1,htnm1, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8, & - !$acc stressp_1,stressp_2,stressp_3,stressp_4, & - !$acc stressm_1,stressm_2,stressm_3,stressm_4, & - !$acc stress12_1,stress12_2,stress12_3,stress12_4, & - !$acc divu,rdg_conv,rdg_shear,shear) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - tinyarea = puny*dxt(iw)*dyt(iw) - dxhy = p5*(hte(iw) - htem1(iw)) - dyhx = p5*(htn(iw) - htnm1(iw)) - cxp = c1p5*htn(iw) - p5*htnm1(iw) - cyp = c1p5*hte(iw) - p5*htem1(iw) - cxm = -(c1p5*htnm1(iw) - p5*htn(iw)) - cym = -(c1p5*htem1(iw) - p5*hte(iw)) - - !----------------------------------------------------------------- - ! strain rates - ! NOTE these are actually strain rates * area (m^2/s) - !----------------------------------------------------------------- - ! divergence = e_11 + e_22 - tmp_uvel_ee = uvel(ee(iw)) - tmp_vvel_se = vvel(se(iw)) - tmp_vvel_ee = vvel(ee(iw)) - tmp_vvel_ne = vvel(ne(iw)) - tmp_uvel_ne = uvel(ne(iw)) - tmp_uvel_se = uvel(se(iw)) - - divune = cyp*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxp*vvel(iw) - dxt(iw)*tmp_vvel_se - divunw = cym*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxp*tmp_vvel_ee - dxt(iw)*tmp_vvel_ne - divusw = cym*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxm*tmp_vvel_ne + dxt(iw)*tmp_vvel_ee - divuse = cyp*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxm*tmp_vvel_se + dxt(iw)*vvel(iw) - - ! tension strain rate = e_11 - e_22 - tensionne = -cym*uvel(iw) - dyt(iw)*tmp_uvel_ee & - + cxm*vvel(iw) + dxt(iw)*tmp_vvel_se - tensionnw = -cyp*tmp_uvel_ee + dyt(iw)*uvel(iw) & - + cxm*tmp_vvel_ee + dxt(iw)*tmp_vvel_ne - tensionsw = -cyp*tmp_uvel_ne + dyt(iw)*tmp_uvel_se & - + cxp*tmp_vvel_ne - dxt(iw)*tmp_vvel_ee - tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & - + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) - - ! shearing strain rate = 2*e_12 - shearne = -cym*vvel(iw) - dyt(iw)*tmp_vvel_ee & - - cxm*uvel(iw) - dxt(iw)*tmp_uvel_se - shearnw = -cyp*tmp_vvel_ee + dyt(iw)*vvel(iw) & - - cxm*tmp_uvel_ee - dxt(iw)*tmp_uvel_ne - shearsw = -cyp*tmp_vvel_ne + dyt(iw)*tmp_vvel_se & - - cxp*tmp_uvel_ne + dxt(iw)*tmp_uvel_ee - shearse = -cym*tmp_vvel_se - dyt(iw)*tmp_vvel_ne & - - cxp*tmp_uvel_se + dxt(iw)*uvel(iw) - - ! Delta (in the denominator of zeta, eta) - Deltane = sqrt(divune**2 + ecci*(tensionne**2 + shearne**2)) - Deltanw = sqrt(divunw**2 + ecci*(tensionnw**2 + shearnw**2)) - Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) - Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) - - !----------------------------------------------------------------- - ! on last subcycle, save quantities for mechanical redistribution - !----------------------------------------------------------------- - divu(iw) = p25*(divune + divunw + divuse + divusw) * tarear(iw) - rdg_conv(iw) = -min(divu(iw),c0) ! Could move outside the entire "kernel" - rdg_shear(iw) = p5*( p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(iw) -abs(divu(iw)) ) - - ! diagnostic only - ! shear = sqrt(tension**2 + shearing**2) - shear(iw) = p25*tarear(iw)*sqrt( & - (tensionne + tensionnw + tensionse + tensionsw)**2 & - + (shearne + shearnw + shearse + shearsw)**2) - - !----------------------------------------------------------------- - ! replacement pressure/Delta ! kg/s - ! save replacement pressure for principal stress calculation - !----------------------------------------------------------------- - c0ne = strength(iw)/max(Deltane,tinyarea) - c0nw = strength(iw)/max(Deltanw,tinyarea) - c0sw = strength(iw)/max(Deltasw,tinyarea) - c0se = strength(iw)/max(Deltase,tinyarea) - - c1ne = c0ne*arlx1i - c1nw = c0nw*arlx1i - c1sw = c0sw*arlx1i - c1se = c0se*arlx1i - - c0ne = c1ne*ecci - c0nw = c1nw*ecci - c0sw = c1sw*ecci - c0se = c1se*ecci - - !----------------------------------------------------------------- - ! the stresses ! kg/s^2 - ! (1) northeast, (2) northwest, (3) southwest, (4) southeast - !----------------------------------------------------------------- - - stressp_1(iw) = (stressp_1(iw)*(c1-arlx1i*revp) + c1ne*(divune*(c1+Ktens) - Deltane*(c1-Ktens))) * denom1 - stressp_2(iw) = (stressp_2(iw)*(c1-arlx1i*revp) + c1nw*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens))) * denom1 - stressp_3(iw) = (stressp_3(iw)*(c1-arlx1i*revp) + c1sw*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens))) * denom1 - stressp_4(iw) = (stressp_4(iw)*(c1-arlx1i*revp) + c1se*(divuse*(c1+Ktens) - Deltase*(c1-Ktens))) * denom1 - - stressm_1(iw) = (stressm_1(iw)*(c1-arlx1i*revp) + c0ne*tensionne*(c1+Ktens)) * denom1 - stressm_2(iw) = (stressm_2(iw)*(c1-arlx1i*revp) + c0nw*tensionnw*(c1+Ktens)) * denom1 - stressm_3(iw) = (stressm_3(iw)*(c1-arlx1i*revp) + c0sw*tensionsw*(c1+Ktens)) * denom1 - stressm_4(iw) = (stressm_4(iw)*(c1-arlx1i*revp) + c0se*tensionse*(c1+Ktens)) * denom1 - - stress12_1(iw) = (stress12_1(iw)*(c1-arlx1i*revp) + c0ne*shearne*p5*(c1+Ktens)) * denom1 - stress12_2(iw) = (stress12_2(iw)*(c1-arlx1i*revp) + c0nw*shearnw*p5*(c1+Ktens)) * denom1 - stress12_3(iw) = (stress12_3(iw)*(c1-arlx1i*revp) + c0sw*shearsw*p5*(c1+Ktens)) * denom1 - stress12_4(iw) = (stress12_4(iw)*(c1-arlx1i*revp) + c0se*shearse*p5*(c1+Ktens)) * denom1 - - !----------------------------------------------------------------- - ! combinations of the stresses for the momentum equation ! kg/s^2 - !----------------------------------------------------------------- - - ssigpn = stressp_1(iw) + stressp_2(iw) - ssigps = stressp_3(iw) + stressp_4(iw) - ssigpe = stressp_1(iw) + stressp_4(iw) - ssigpw = stressp_2(iw) + stressp_3(iw) - ssigp1 =(stressp_1(iw) + stressp_3(iw))*p055 - ssigp2 =(stressp_2(iw) + stressp_4(iw))*p055 - - ssigmn = stressm_1(iw) + stressm_2(iw) - ssigms = stressm_3(iw) + stressm_4(iw) - ssigme = stressm_1(iw) + stressm_4(iw) - ssigmw = stressm_2(iw) + stressm_3(iw) - ssigm1 =(stressm_1(iw) + stressm_3(iw))*p055 - ssigm2 =(stressm_2(iw) + stressm_4(iw))*p055 - - ssig12n = stress12_1(iw) + stress12_2(iw) - ssig12s = stress12_3(iw) + stress12_4(iw) - ssig12e = stress12_1(iw) + stress12_4(iw) - ssig12w = stress12_2(iw) + stress12_3(iw) - ssig121 =(stress12_1(iw) + stress12_3(iw))*p111 - ssig122 =(stress12_2(iw) + stress12_4(iw))*p111 - - csigpne = p111*stressp_1(iw) + ssigp2 + p027*stressp_3(iw) - csigpnw = p111*stressp_2(iw) + ssigp1 + p027*stressp_4(iw) - csigpsw = p111*stressp_3(iw) + ssigp2 + p027*stressp_1(iw) - csigpse = p111*stressp_4(iw) + ssigp1 + p027*stressp_2(iw) - - csigmne = p111*stressm_1(iw) + ssigm2 + p027*stressm_3(iw) - csigmnw = p111*stressm_2(iw) + ssigm1 + p027*stressm_4(iw) - csigmsw = p111*stressm_3(iw) + ssigm2 + p027*stressm_1(iw) - csigmse = p111*stressm_4(iw) + ssigm1 + p027*stressm_2(iw) - - csig12ne = p222*stress12_1(iw) + ssig122 + p055*stress12_3(iw) - csig12nw = p222*stress12_2(iw) + ssig121 + p055*stress12_4(iw) - csig12sw = p222*stress12_3(iw) + ssig122 + p055*stress12_1(iw) - csig12se = p222*stress12_4(iw) + ssig121 + p055*stress12_2(iw) - - str12ew = p5*dxt(iw)*(p333*ssig12e + p166*ssig12w) - str12we = p5*dxt(iw)*(p333*ssig12w + p166*ssig12e) - str12ns = p5*dyt(iw)*(p333*ssig12n + p166*ssig12s) - str12sn = p5*dyt(iw)*(p333*ssig12s + p166*ssig12n) - - !----------------------------------------------------------------- - ! for dF/dx (u momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dyt(iw)*(p333*ssigpn + p166*ssigps) - strm_tmp = p25*dyt(iw)*(p333*ssigmn + p166*ssigms) - - ! northeast (iw) - str1(iw) = -strp_tmp - strm_tmp - str12ew & - + dxhy*(-csigpne + csigmne) + dyhx*csig12ne - - ! northwest (i+1,j) - str2(iw) = strp_tmp + strm_tmp - str12we & - + dxhy*(-csigpnw + csigmnw) + dyhx*csig12nw - - strp_tmp = p25*dyt(iw)*(p333*ssigps + p166*ssigpn) - strm_tmp = p25*dyt(iw)*(p333*ssigms + p166*ssigmn) - - ! southeast (i,j+1) - str3(iw) = -strp_tmp - strm_tmp + str12ew & - + dxhy*(-csigpse + csigmse) + dyhx*csig12se - - ! southwest (i+1,j+1) - str4(iw) = strp_tmp + strm_tmp + str12we & - + dxhy*(-csigpsw + csigmsw) + dyhx*csig12sw - - !----------------------------------------------------------------- - ! for dF/dy (v momentum) - !----------------------------------------------------------------- - strp_tmp = p25*dxt(iw)*(p333*ssigpe + p166*ssigpw) - strm_tmp = p25*dxt(iw)*(p333*ssigme + p166*ssigmw) - - ! northeast (i,j) - str5(iw) = -strp_tmp + strm_tmp - str12ns & - - dyhx*(csigpne + csigmne) + dxhy*csig12ne - - ! southeast (i,j+1) - str6(iw) = strp_tmp - strm_tmp - str12sn & - - dyhx*(csigpse + csigmse) + dxhy*csig12se - - strp_tmp = p25*dxt(iw)*(p333*ssigpw + p166*ssigpe) - strm_tmp = p25*dxt(iw)*(p333*ssigmw + p166*ssigme) - - ! northwest (i+1,j) - str7(iw) = -strp_tmp + strm_tmp + str12ns & - - dyhx*(csigpnw + csigmnw) + dxhy*csig12nw - - ! southwest (i+1,j+1) - str8(iw) = strp_tmp - strm_tmp + str12sn & - - dyhx*(csigpsw + csigmsw) + dxhy*csig12sw - enddo -#ifdef _OPENACC - !$acc end parallel -#endif - end subroutine stress_l - -!---------------------------------------------------------------------------- - - subroutine stepu_iter(NA_len,rhow, & - lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) - - use ice_kinds_mod - use ice_dyn_shared, only: brlx, revp - use ice_constants, only: c0, c1 - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - real (kind=dbl_kind), intent(in) :: rhow - integer(kind=int_kind),intent(in) :: lb,ub - logical(kind=log_kind),intent(in), dimension(:) :: skipme - integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se - real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear,Cw - real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & - uvel,vvel - real (kind=dbl_kind), parameter :: & - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb - real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw, tmp_strintx - real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw, tmp_strinty - real (kind=dbl_kind) :: waterx,watery - real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for seabed stress (m/s) - - character(len=*), parameter :: subname = '(stepu_iter)' - !--------------------------------------- + uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 + vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 + end do #ifdef _OPENACC - !$acc parallel & - !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - !$acc uvel_init,vvel_init,nw,sw,se,skipme, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel) - !$acc loop - do iw = 1,NA_len -#else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - if (skipme(iw)) cycle - uold = uvel(iw) - vold = vvel(iw) - vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) - waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) - watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) - taux = vrel*waterx - tauy = vrel*watery - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw - ab2 = cca**2 + ccb**2 - ! southeast(i,j+1) = se - ! northwest(i+1,j) = nw - ! southwest(i+1,j+1) = sw - tmp_str2_nw = str2(nw(iw)) - tmp_str3_se = str3(se(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_se = str6(se(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - tmp_strintx = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) - tmp_strinty = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) - cc1 = tmp_strintx + forcex(iw) + taux & - + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) - cc2 = tmp_strinty + forcey(iw) + tauy & - + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) - uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 - vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 - enddo -#ifdef _OPENACC - !$acc end parallel + !$acc end parallel #endif - end subroutine stepu_iter - -!---------------------------------------------------------------------------- - - subroutine stepu_last(NA_len, rhow, & - lb,ub,Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - strintx,strinty,taubx,tauby, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,se,skipme) - - use ice_kinds_mod - use ice_constants, only: c0, c1 - use ice_dyn_shared, only: brlx, revp, seabed_stress - - implicit none - - integer (kind=int_kind), intent(in) :: NA_len - real (kind=dbl_kind), intent(in) :: rhow - logical(kind=log_kind),intent(in), dimension(:) :: skipme - integer(kind=int_kind),intent(in) :: lb,ub - integer(kind=int_kind),dimension(:), intent(in), contiguous :: nw,sw,se - real(kind=dbl_kind),dimension(:), intent(in), contiguous :: & - uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & - uocn, vocn, fm, uarear,Cw - real(kind=DBL_KIND),dimension(:), intent(in), contiguous :: & - str1,str2,str3,str4,str5,str6,str7,str8 - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: & - uvel,vvel, strintx,strinty, taubx,tauby - real (kind=dbl_kind), parameter :: & - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 - - !-- local variables - - integer (kind=int_kind) :: iw,il,iu - real (kind=dbl_kind) :: uold, vold, vrel,cca,ccb,ab2,cc1,cc2,taux,tauy,Cb - real (kind=dbl_kind) :: tmp_str2_nw,tmp_str3_se,tmp_str4_sw - real (kind=dbl_kind) :: tmp_str6_se,tmp_str7_nw,tmp_str8_sw - real (kind=dbl_kind) :: waterx,watery - real (kind=dbl_kind) :: u0 = 5.e-5_dbl_kind ! residual velocity for seabed stress (m/s) - - character(len=*), parameter :: subname = '(stepu_last)' - !--------------------------------------- + end subroutine stepu_iter + +!======================================================================= + + subroutine stepu_last(NA_len, rhow, lb, ub, Cw, aiu, uocn, vocn, & + forcex, forcey, umassdti, fm, uarear, Tbu, uvel_init, vvel_init, & + uvel, vvel, str1, str2, str3, str4, str5, str6, str7, str8, nw, & + sw, sse, skipucell, strintx, strinty, taubx, tauby) + + use ice_kinds_mod + use ice_constants, only : c0, c1 + use ice_dyn_shared, only : brlx, revp, u0, cosw, sinw, & + seabed_stress + + implicit none + + integer(kind=int_kind), intent(in) :: NA_len, lb, ub + real(kind=dbl_kind), intent(in) :: rhow + logical(kind=log_kind), intent(in), dimension(:) :: skipucell + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + nw, sw, sse + real(kind=dbl_kind), dimension(:), intent(in), contiguous :: & + uvel_init, vvel_init, aiu, forcex, forcey, umassdti, Tbu, & + uocn, vocn, fm, uarear, Cw, str1, str2, str3, str4, str5, & + str6, str7, str8 + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel, strintx, strinty, taubx, tauby + + ! local variables + + integer(kind=int_kind) :: iw, il, iu + real(kind=dbl_kind) :: uold, vold, vrel, cca, ccb, ab2, cc1, & + cc2, taux, tauy, Cb, tmp_str2_nw, tmp_str3_sse, tmp_str4_sw, & + tmp_str6_sse, tmp_str7_nw, tmp_str8_sw, waterx, watery + + character(len=*), parameter :: subname = '(stepu_last)' #ifdef _OPENACC - !$acc parallel & - !$acc present(Cw,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu, & - !$acc strintx,strinty,taubx,tauby,uvel_init,vvel_init,nw,sw,se,skipme, & - !$acc str1,str2,str3,str4,str5,str6,str7,str8,uvel,vvel ) - !$acc loop - do iw = 1,NA_len + !$acc parallel & + !$acc present(Cw, aiu, uocn, vocn, forcex, forcey, umassdti, fm, & + !$acc uarear, Tbu, uvel_init, vvel_init, nw, sw, sse, skipucell, & + !$acc str1, str2, str3, str4, str5, str6, str7, str8, uvel, & + !$acc vvel, strintx, strinty, taubx, tauby) + !$acc loop + do iw = 1, NA_len #else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu #endif - if (skipme(iw)) cycle - uold = uvel(iw) - vold = vvel(iw) - vrel = aiu(iw)*rhow*Cw(iw)*sqrt((uocn(iw)-uold)**2+(vocn(iw)-vold)**2) - waterx = uocn(iw)*cosw - vocn(iw)*sinw*sign(c1,fm(iw)) - watery = vocn(iw)*cosw + uocn(iw)*sinw*sign(c1,fm(iw)) - taux = vrel*waterx - tauy = vrel*watery - Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - cca = (brlx + revp)*umassdti(iw) + vrel * cosw + Cb - ccb = fm(iw) + sign(c1,fm(iw)) * vrel * sinw - ab2 = cca**2 + ccb**2 - ! southeast(i,j+1) = se - ! northwest(i+1,j) = nw - ! southwest(i+1,j+1) = sw - tmp_str2_nw = str2(nw(iw)) - tmp_str3_se = str3(se(iw)) - tmp_str4_sw = str4(sw(iw)) - tmp_str6_se = str6(se(iw)) - tmp_str7_nw = str7(nw(iw)) - tmp_str8_sw = str8(sw(iw)) - - strintx(iw) = uarear(iw)*(str1(iw)+tmp_str2_nw+tmp_str3_se+tmp_str4_sw) - strinty(iw) = uarear(iw)*(str5(iw)+tmp_str6_se+tmp_str7_nw+tmp_str8_sw) - cc1 = strintx(iw) + forcex(iw) + taux & - + umassdti(iw)*(brlx*uold + revp*uvel_init(iw)) - cc2 = strinty(iw) + forcey(iw) + tauy & - + umassdti(iw)*(brlx*vold + revp*vvel_init(iw)) - uvel(iw) = (cca*cc1 + ccb*cc2) / ab2 - vvel(iw) = (cca*cc2 - ccb*cc1) / ab2 - ! calculate seabed stress component for outputs - if ( seabed_stress ) then - taubx(iw) = -uvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - tauby(iw) = -vvel(iw)*Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) - endif - enddo + + if (skipucell(iw)) cycle + + uold = uvel(iw) + vold = vvel(iw) + + vrel = aiu(iw) * rhow * Cw(iw) * sqrt((uocn(iw) - uold)**2 + (vocn(iw) - vold)**2) + + waterx = uocn(iw) * cosw - vocn(iw) * sinw * sign(c1, fm(iw)) + watery = vocn(iw) * cosw + uocn(iw) * sinw * sign(c1, fm(iw)) + + taux = vrel * waterx + tauy = vrel * watery + + Cb = Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + + cca = (brlx + revp) * umassdti(iw) + vrel * cosw + Cb + ccb = fm(iw) + sign(c1, fm(iw)) * vrel * sinw + + ab2 = cca**2 + ccb**2 + + tmp_str2_nw = str2(nw(iw)) + tmp_str3_sse = str3(sse(iw)) + tmp_str4_sw = str4(sw(iw)) + tmp_str6_sse = str6(sse(iw)) + tmp_str7_nw = str7(nw(iw)) + tmp_str8_sw = str8(sw(iw)) + + strintx(iw) = uarear(iw) * (str1(iw) + tmp_str2_nw + tmp_str3_sse + tmp_str4_sw) + strinty(iw) = uarear(iw) * (str5(iw) + tmp_str6_sse + tmp_str7_nw + tmp_str8_sw) + + cc1 = strintx(iw) + forcex(iw) + taux & + + umassdti(iw) * (brlx * uold + revp * uvel_init(iw)) + cc2 = strinty(iw) + forcey(iw) + tauy & + + umassdti(iw) * (brlx * vold + revp * vvel_init(iw)) + + uvel(iw) = (cca * cc1 + ccb * cc2) / ab2 + vvel(iw) = (cca * cc2 - ccb * cc1) / ab2 + + ! calculate seabed stress component for outputs + if (seabed_stress) then + taubx(iw) = -uvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + tauby(iw) = -vvel(iw) * Tbu(iw) / (sqrt(uold**2 + vold**2) + u0) + end if + + end do #ifdef _OPENACC - !$acc end parallel + !$acc end parallel #endif - end subroutine stepu_last + end subroutine stepu_last -!---------------------------------------------------------------------------- +!======================================================================= - subroutine evp1d_halo_update(NAVEL_len,lb,ub,uvel,vvel, halo_parent) + subroutine evp1d_halo_update(NAVEL_len, lb, ub, uvel, vvel, & + halo_parent) - use ice_kinds_mod + use ice_kinds_mod - implicit none + implicit none - integer (kind=int_kind), intent(in) :: NAVEL_len - integer(kind=int_kind),intent(in) :: lb,ub - integer(kind=int_kind),dimension(:), intent(in), contiguous :: halo_parent - real(kind=dbl_kind),dimension(:), intent(inout), contiguous :: uvel,vvel + integer(kind=int_kind), intent(in) :: NAVEL_len, lb, ub + integer(kind=int_kind), dimension(:), intent(in), contiguous :: & + halo_parent + real(kind=dbl_kind), dimension(:), intent(inout), contiguous :: & + uvel, vvel - !-- local variables + ! local variables - integer (kind=int_kind) :: iw,il,iu + integer (kind=int_kind) :: iw, il, iu - character(len=*), parameter :: subname = '(evp1d_halo_update)' - !--------------------------------------- + character(len=*), parameter :: subname = '(evp1d_halo_update)' #ifdef _OPENACC - !$acc parallel & - !$acc present(uvel,vvel) & - !$acc loop - do iw = 1,NAVEL_len + !$acc parallel & + !$acc present(uvel, vvel) & + !$acc loop + do iw = 1, NAVEL_len + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do + !$acc end parallel #else - call domp_get_domain(lb,ub,il,iu) - do iw = il, iu -#endif - if (halo_parent(iw)==0) cycle - uvel(iw) = uvel(halo_parent(iw)) - vvel(iw) = vvel(halo_parent(iw)) - enddo -#ifdef _OPENACC - !$acc end parallel + call domp_get_domain(lb, ub, il, iu) + do iw = il, iu + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do + call domp_get_domain(ub + 1, NAVEL_len, il, iu) + do iw = il, iu + if (halo_parent(iw) == 0) cycle + uvel(iw) = uvel(halo_parent(iw)) + vvel(iw) = vvel(halo_parent(iw)) + end do #endif - end subroutine evp1d_halo_update - -!---------------------------------------------------------------------------- - -!former end module bench_v2 - -!=============================================================================== -!---------------------------------------------------------------------------- - - subroutine alloc1d(na) - - implicit none - - integer(kind=int_kind),intent(in) :: na - integer(kind=int_kind) :: ierr,nb - - character(len=*), parameter :: subname = '(alloc1d)' - !--------------------------------------- - - nb=na - allocate( & - ! U+T cells - ! Helper index for neighbours - indj(1:na),indi(1:na), & - ee(1:na),ne(1:na),se(1:na), & - nw(1:nb),sw(1:nb),sse(1:nb), & - skipucell(1:na), & - ! Grid distances: HTE,HTN + "-1 neighbours" - HTE(1:na),HTN(1:na), & - HTEm1(1:na),HTNm1(1:na), & - ! T cells -!v1 dxhy(1:na),dyhx(1:na),cyp(1:na),cxp(1:na),cym(1:na),cxm(1:na),tinyarea(1:na),& - strength(1:na),dxt(1:na),dyt(1:na), tarear(1:na), & - stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), stressp_4(1:na), & - stressm_1(1:na), stressm_2(1:na), stressm_3(1:na), stressm_4(1:na), & - stress12_1(1:na),stress12_2(1:na),stress12_3(1:na),stress12_4(1:na),& - divu(1:na),rdg_conv(1:na),rdg_shear(1:na),shear(1:na), & - ! U cells -!v1 waterx(1:nb),watery(1:nb), & - cdn_ocn(1:nb),aiu(1:nb),uocn(1:nb),vocn(1:nb), & - forcex(1:nb),forcey(1:nb),Tbu(1:nb), & - umassdti(1:nb),fm(1:nb),uarear(1:nb), & - strintx(1:nb),strinty(1:nb), & - uvel_init(1:nb),vvel_init(1:nb), & - taubx(1:nb),tauby(1:nb), & - stat=ierr) - - if (ierr/=0) call abort_ice(subname//': ERROR allocating 1D') - - end subroutine alloc1d - -!---------------------------------------------------------------------------- - - subroutine alloc1d_navel(navel) - - implicit none - - integer(kind=int_kind),intent(in) :: navel - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(alloc1d_navel)' - !--------------------------------------- - - allocate( & - uvel(1:navel),vvel(1:navel), indij(1:navel), halo_parent(1:navel), & - str1(1:navel),str2(1:navel),str3(1:navel),str4(1:navel), & - str5(1:navel),str6(1:navel),str7(1:navel),str8(1:navel), & - stat=ierr) - if (ierr/=0) call abort_ice(subname// ': Error allocating 1D navel') - - end subroutine alloc1d_navel - -!---------------------------------------------------------------------------- - - subroutine dealloc1d - - implicit none - - integer(kind=int_kind) :: ierr - - character(len=*), parameter :: subname = '(dealloc1d)' - !--------------------------------------- - - deallocate( & - ! U+T cells - ! Helper index for neighbours - indj,indi, & - ee,ne,se, & - nw,sw,sse, & - skipucell, & - ! T cells - strength,dxt,dyt,tarear, & - stressp_1, stressp_2, stressp_3, stressp_4, & - stressm_1, stressm_2, stressm_3, stressm_4, & - stress12_1,stress12_2,stress12_3,stress12_4,& - str1, str2,str3,str4, & - str5, str6,str7,str8, & - divu,rdg_conv,rdg_shear,shear, & - ! U cells - cdn_ocn,aiu,uocn,vocn, & - forcex,forcey,Tbu, & - umassdti,fm,uarear, & - strintx,strinty, & - uvel_init,vvel_init, & - taubx,tauby, & - ! NAVEL - uvel,vvel, indij, halo_parent, & - stat=ierr) - - if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D') - -!v1 if (allocated(tinyarea)) then -!v1 deallocate( & -!v1 dxhy,dyhx,cyp,cxp,cym,cxm,tinyarea, & -!v1 waterx,watery, & -!v1 stat=ierr) -!v1 if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v1') -!v1 endif - - if (allocated(HTE)) then - deallocate( & - ! Grid distances: HTE,HTN + "-1 neighbours" - HTE,HTN, HTEm1,HTNm1, & - stat=ierr) - if (ierr/=0) call abort_ice(subname//': Error de-allocating 1D, v2') - endif - - end subroutine dealloc1d - -!---------------------------------------------------------------------------- - - subroutine evp_copyin_v2(nx,ny,nblk,nx_glob,ny_glob, & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_icetmask,I_iceumask, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) - - use ice_gather_scatter, only: gather_global_ext - use ice_domain, only: distrb_info - use ice_communicate, only: my_task, master_task - - implicit none - - integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob - integer (kind=int_kind),dimension (nx,ny,nblk), intent(in) :: I_icetmask - logical (kind=log_kind),dimension (nx,ny,nblk), intent(in) :: I_iceumask - real (kind=dbl_kind), dimension(nx,ny,nblk), intent(in) :: & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty,I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 - - !-- local variables - - integer (kind=int_kind),dimension (nx_glob,ny_glob) :: G_icetmask - logical (kind=log_kind),dimension (nx_glob,ny_glob) :: G_iceumask - real (kind=dbl_kind), dimension(nx_glob,ny_glob) :: & - G_HTE,G_HTN, & -!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & -!v1 G_waterx,G_watery, & - G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & - G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & - G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 - integer(kind=int_kind) :: na, navel - - character(len=*), parameter :: subname = '(evp_copyin_v2)' - !--------------------------------------- - !-- Gather data into one single block -- - - call gather_global_ext(G_icetmask, I_icetmask, master_task, distrb_info) - call gather_global_ext(G_iceumask, I_iceumask, master_task, distrb_info) - call gather_global_ext(G_HTE, I_HTE, master_task, distrb_info) - call gather_global_ext(G_HTN, I_HTN, master_task, distrb_info) -!v1 call gather_global_ext(G_dxhy, I_dxhy, master_task, distrb_info) -!v1 call gather_global_ext(G_dyhx, I_dyhx, master_task, distrb_info) -!v1 call gather_global_ext(G_cyp, I_cyp, master_task, distrb_info) -!v1 call gather_global_ext(G_cxp, I_cxp, master_task, distrb_info) -!v1 call gather_global_ext(G_cym, I_cym, master_task, distrb_info) -!v1 call gather_global_ext(G_cxm, I_cxm, master_task, distrb_info) -!v1 call gather_global_ext(G_tinyarea, I_tinyarea, master_task, distrb_info) -!v1 call gather_global_ext(G_waterx, I_waterx, master_task, distrb_info) -!v1 call gather_global_ext(G_watery, I_watery, master_task, distrb_info) - call gather_global_ext(G_cdn_ocn, I_cdn_ocn, master_task, distrb_info) - call gather_global_ext(G_aiu, I_aiu, master_task, distrb_info) - call gather_global_ext(G_uocn, I_uocn, master_task, distrb_info) - call gather_global_ext(G_vocn, I_vocn, master_task, distrb_info) - call gather_global_ext(G_forcex, I_forcex, master_task, distrb_info) - call gather_global_ext(G_forcey, I_forcey, master_task, distrb_info) - call gather_global_ext(G_Tbu, I_Tbu, master_task, distrb_info) - call gather_global_ext(G_umassdti, I_umassdti, master_task, distrb_info) - call gather_global_ext(G_fm, I_fm, master_task, distrb_info) - call gather_global_ext(G_uarear, I_uarear, master_task, distrb_info) - call gather_global_ext(G_tarear, I_tarear, master_task, distrb_info) - call gather_global_ext(G_strintx, I_strintx, master_task, distrb_info) - call gather_global_ext(G_strinty, I_strinty, master_task, distrb_info) - call gather_global_ext(G_uvel_init, I_uvel_init, master_task, distrb_info) - call gather_global_ext(G_vvel_init, I_vvel_init, master_task, distrb_info) - call gather_global_ext(G_strength, I_strength, master_task, distrb_info) - call gather_global_ext(G_uvel, I_uvel, master_task, distrb_info) - call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info) - call gather_global_ext(G_dxt, I_dxt, master_task, distrb_info) - call gather_global_ext(G_dyt, I_dyt, master_task, distrb_info) - call gather_global_ext(G_stressp_1, I_stressp_1, master_task, distrb_info) - call gather_global_ext(G_stressp_2, I_stressp_2, master_task, distrb_info) - call gather_global_ext(G_stressp_3, I_stressp_3, master_task, distrb_info) - call gather_global_ext(G_stressp_4, I_stressp_4, master_task, distrb_info) - call gather_global_ext(G_stressm_1, I_stressm_1, master_task, distrb_info) - call gather_global_ext(G_stressm_2, I_stressm_2, master_task, distrb_info) - call gather_global_ext(G_stressm_3, I_stressm_3, master_task, distrb_info) - call gather_global_ext(G_stressm_4, I_stressm_4, master_task, distrb_info) - call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info) - call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info) - call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info) - call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info) - - !-- All calculations has to be done on the master-task -- - - if (my_task == master_task) then - !-- Find number of active points and allocate vectors -- - call calc_na(nx_glob,ny_glob,na,G_icetmask) - call alloc1d(na) - call calc_2d_indices(nx_glob,ny_glob,na, G_icetmask, G_iceumask) - call calc_navel(nx_glob,ny_glob,na,navel) - call alloc1d_navel(navel) -!MHRI !$OMP PARALLEL DEFAULT(shared) - call numainit(1,na,navel) -!MHRI !$OMP END PARALLEL - ! Remap 2d to 1d and fill in - call convert_2d_1d(nx_glob,ny_glob,na,navel, & - G_HTE,G_HTN, & -!v1 G_dxhy,G_dyhx,G_cyp,G_cxp,G_cym,G_cxm,G_tinyarea, & -!v1 G_waterx,G_watery, & - G_cdn_ocn,G_aiu,G_uocn,G_vocn,G_forcex,G_forcey,G_Tbu, & - G_umassdti,G_fm,G_uarear,G_tarear,G_strintx,G_strinty,G_uvel_init,G_vvel_init, & - G_strength,G_uvel,G_vvel,G_dxt,G_dyt, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4 ) - call calc_halo_parent(nx_glob,ny_glob,na,navel, G_icetmask) - NA_len=na - NAVEL_len=navel - endif - - !-- write check -!if (1 == 1) then -! write(nu_diag,*) subname,' MHRI: INDICES start:' -! write(nu_diag,*) 'na,navel ', na,navel -! write(nu_diag,*) 'Min/max ee', minval(ee(1:na)), maxval(ee(1:na)) -! write(nu_diag,*) 'Min/max ne', minval(ne(1:na)), maxval(ne(1:na)) -! write(nu_diag,*) 'Min/max se', minval(se(1:na)), maxval(se(1:na)) -! write(nu_diag,*) 'Min/max nw', minval(nw(1:na)), maxval(nw(1:na)) -! write(nu_diag,*) 'Min/max sw', minval(sw(1:na)), maxval(sw(1:na)) -! write(nu_diag,*) 'Min/max sse', minval(sse(1:na)), maxval(sse(1:na)) -! write(nu_diag,*) subname,' MHRI: INDICES end:' -!endif - - end subroutine evp_copyin_v2 - -!---------------------------------------------------------------------------- - - subroutine evp_copyout(nx,ny,nblk,nx_glob,ny_glob, & - I_uvel,I_vvel, I_strintx,I_strinty, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & - I_divu,I_rdg_conv,I_rdg_shear,I_shear,I_taubx,I_tauby ) - - use ice_constants, only : c0 - use ice_gather_scatter, only: scatter_global_ext - use ice_domain, only: distrb_info - use ice_communicate, only: my_task, master_task - - implicit none - - integer(int_kind), intent(in) :: nx,ny,nblk, nx_glob,ny_glob - real(dbl_kind), dimension(nx,ny,nblk), intent(out) :: & - I_uvel,I_vvel, I_strintx,I_strinty, & - I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4, & - I_divu,I_rdg_conv, I_rdg_shear,I_shear, I_taubx,I_tauby - - !-- local variables - - real(dbl_kind), dimension(nx_glob,ny_glob) :: & - G_uvel,G_vvel, G_strintx,G_strinty, & - G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & - G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & - G_stress12_1,G_stress12_2,G_stress12_3,G_stress12_4, & - G_divu,G_rdg_conv, G_rdg_shear,G_shear, G_taubx,G_tauby - integer(int_kind) :: i,j,iw, nx_block - - character(len=*), parameter :: subname = '(evp_copyout)' - !--------------------------------------- - ! Remap 1d to 2d and fill in - nx_block=nx_glob ! Total block size in x-dir - - if (my_task == master_task) then - G_uvel = c0 - G_vvel = c0 - G_strintx = c0 - G_strinty = c0 - G_stressp_1 = c0 - G_stressp_2 = c0 - G_stressp_3 = c0 - G_stressp_4 = c0 - G_stressm_1 = c0 - G_stressm_2 = c0 - G_stressm_3 = c0 - G_stressm_4 = c0 - G_stress12_1 = c0 - G_stress12_2 = c0 - G_stress12_3 = c0 - G_stress12_4 = c0 - G_divu = c0 - G_rdg_conv = c0 - G_rdg_shear = c0 - G_shear = c0 - G_taubx = c0 - G_tauby = c0 - !$OMP PARALLEL PRIVATE(iw,i,j) - do iw=1,NAVEL_len - j=int((indij(iw)-1)/(nx_block))+1 - i=indij(iw)-(j-1)*nx_block - G_uvel(i,j) = uvel(iw) - G_vvel(i,j) = vvel(iw) - enddo - !$OMP END PARALLEL - !$OMP PARALLEL PRIVATE(iw,i,j) - do iw=1,NA_len - i=indi(iw) - j=indj(iw) -! G_uvel(i,j) = uvel(iw) ! done above -! G_vvel(i,j) = vvel(iw) ! done above - G_strintx(i,j) = strintx(iw) - G_strinty(i,j) = strinty(iw) - G_stressp_1(i,j) = stressp_1(iw) - G_stressp_2(i,j) = stressp_2(iw) - G_stressp_3(i,j) = stressp_3(iw) - G_stressp_4(i,j) = stressp_4(iw) - G_stressm_1(i,j) = stressm_1(iw) - G_stressm_2(i,j) = stressm_2(iw) - G_stressm_3(i,j) = stressm_3(iw) - G_stressm_4(i,j) = stressm_4(iw) - G_stress12_1(i,j) = stress12_1(iw) - G_stress12_2(i,j) = stress12_2(iw) - G_stress12_3(i,j) = stress12_3(iw) - G_stress12_4(i,j) = stress12_4(iw) - G_divu(i,j) = divu(iw) - G_rdg_conv(i,j) = rdg_conv(iw) - G_rdg_shear(i,j) = rdg_shear(iw) - G_shear(i,j) = shear(iw) - G_taubx(i,j) = taubx(iw) - G_tauby(i,j) = tauby(iw) - enddo - !$OMP END PARALLEL - call dealloc1d() - endif - - !-- Scatter data into blocks -- - !-- has to be done on all tasks -- - - call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) - call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) - call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) - call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) - call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) - call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) - call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) - call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) - call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) - call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) - call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) - call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) - call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) - call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) - call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) - call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) - call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) - call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) - call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) - call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) - call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) - call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) - - end subroutine evp_copyout - -!---------------------------------------------------------------------------- - - subroutine evp_kernel_v2 - - use ice_constants, only : c0 - use ice_dyn_shared, only: ndte - use ice_communicate, only: my_task, master_task - implicit none - - real(kind=dbl_kind) :: rhow - integer (kind=int_kind) :: i, nthreads - integer (kind=int_kind) :: na,nb,navel - - character(len=*), parameter :: subname = '(evp_kernel_v2)' - !--------------------------------------- - !-- All calculations has to be done on one single node (choose master-task) -- - - if (my_task == master_task) then - - !- Read constants... - call icepack_query_parameters(rhow_out=rhow) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - na=NA_len - nb=NA_len - navel=NAVEL_len - - !- Initialize openmp --------------------------------------------------------- - call domp_init(nthreads) ! ought to be called from main - - !- Initialize timers --------------------------------------------------------- - str1=c0 - str2=c0 - str3=c0 - str4=c0 - str5=c0 - str6=c0 - str7=c0 - str8=c0 - - if (ndte<2) call abort_ice(subname//' ERROR: ndte must be 2 or higher for this kernel') - - !$OMP PARALLEL PRIVATE(i) - do i = 1, ndte-1 - call evp1d_stress(NA_len, & - ee,ne,se,1,na,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4,str1,str2,str3, & - str4,str5,str6,str7,str8) - !$OMP BARRIER - call evp1d_stepu(NA_len, rhow, & - 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) - !$OMP BARRIER - call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) - !$OMP BARRIER - enddo - - call evp1d_stress(NA_len, tarear, & - ee,ne,se,1,na,uvel,vvel,dxt,dyt, & - hte,htn,htem1,htnm1, & - strength,stressp_1,stressp_2,stressp_3,stressp_4, & - stressm_1,stressm_2,stressm_3,stressm_4,stress12_1, & - stress12_2,stress12_3,stress12_4, & - divu,rdg_conv,rdg_shear,shear, & - str1,str2,str3,str4,str5,str6,str7,str8) - !$OMP BARRIER - call evp1d_stepu(NA_len, rhow, & - 1,nb,cdn_ocn,aiu,uocn,vocn,forcex,forcey,umassdti,fm,uarear,Tbu,& - strintx,strinty,taubx,tauby, & - uvel_init,vvel_init,uvel,vvel, & - str1,str2,str3,str4,str5,str6,str7,str8, nw,sw,sse,skipucell) - !$OMP BARRIER - call evp1d_halo_update(NA_len,1,navel,uvel,vvel, halo_parent) + end subroutine evp1d_halo_update + +!======================================================================= + + subroutine alloc1d(na) + + implicit none + + integer(kind=int_kind), intent(in) :: na + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(alloc1d)' + + allocate( & + ! helper indices for neighbours + indj(1:na), indi(1:na), ee(1:na), ne(1:na), se(1:na), & + nw(1:na), sw(1:na), sse(1:na), skipucell(1:na), & + skiptcell(1:na), & + ! grid distances and their "-1 neighbours" + HTE(1:na), HTN(1:na), HTEm1(1:na), HTNm1(1:na), & + ! T cells + strength(1:na), dxt(1:na), dyt(1:na), tarear(1:na), & + stressp_1(1:na), stressp_2(1:na), stressp_3(1:na), & + stressp_4(1:na), stressm_1(1:na), stressm_2(1:na), & + stressm_3(1:na), stressm_4(1:na), stress12_1(1:na), & + stress12_2(1:na), stress12_3(1:na), stress12_4(1:na), & + divu(1:na), rdg_conv(1:na), rdg_shear(1:na), shear(1:na), & + ! U cells + cdn_ocn(1:na), aiu(1:na), uocn(1:na), vocn(1:na), & + forcex(1:na), forcey(1:na), Tbu(1:na), umassdti(1:na), & + fm(1:na), uarear(1:na), strintx(1:na), strinty(1:na), & + uvel_init(1:na), vvel_init(1:na), taubx(1:na), tauby(1:na), & + ! error handling + stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not allocate 1D arrays') + + end subroutine alloc1d + +!======================================================================= + + subroutine alloc1d_navel(navel) + + implicit none + + integer(kind=int_kind), intent(in) :: navel + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(alloc1d_navel)' + + allocate(uvel(1:navel), vvel(1:navel), indij(1:navel), & + halo_parent(1:navel), str1(1:navel), str2(1:navel), & + str3(1:navel), str4(1:navel), str5(1:navel), str6(1:navel), & + str7(1:navel), str8(1:navel), stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not allocate 1D arrays') + + end subroutine alloc1d_navel + +!======================================================================= + + subroutine dealloc1d + + implicit none + + ! local variables + + integer(kind=int_kind) :: ierr + + character(len=*), parameter :: subname = '(dealloc1d)' + + deallocate( & + ! helper indices for neighbours + indj, indi, ee, ne, se, nw, sw, sse, skipucell, skiptcell, & + ! grid distances and their "-1 neighbours" + HTE, HTN, HTEm1, HTNm1, & + ! T cells + strength, dxt, dyt, tarear, stressp_1, stressp_2, stressp_3, & + stressp_4, stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4, str1, str2, & + str3, str4, str5, str6, str7, str8, divu, rdg_conv, & + rdg_shear, shear, & + ! U cells + cdn_ocn, aiu, uocn, vocn, forcex, forcey, Tbu, umassdti, fm, & + uarear, strintx, strinty, uvel_init, vvel_init, taubx, tauby, & + uvel, vvel, indij, halo_parent, & + ! error handling + stat=ierr) + + if (ierr /= 0) call abort_ice(subname & + // ' ERROR: could not deallocate 1D arrays') + + end subroutine dealloc1d + +!======================================================================= + + subroutine ice_dyn_evp_1d_copyin(nx, ny, nblk, nx_glob, ny_glob, & + I_icetmask, I_iceumask, I_cdn_ocn, I_aiu, I_uocn, I_vocn, & + I_forcex, I_forcey, I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, & + I_strintx, I_strinty, I_uvel_init, I_vvel_init, I_strength, & + I_uvel, I_vvel, I_dxt, I_dyt, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4) + + use ice_gather_scatter, only : gather_global_ext + use ice_domain, only : distrb_info + use ice_communicate, only : my_task, master_task + use ice_grid, only : G_HTE, G_HTN + use ice_constants, only : c0 + + implicit none + + integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob + logical(kind=log_kind), dimension(nx, ny, nblk), intent(in) :: & + I_iceumask + integer(kind=int_kind), dimension(nx, ny, nblk), intent(in) :: & + I_icetmask + real(kind=dbl_kind), dimension(nx, ny, nblk), intent(in) :: & + I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & + I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & + I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxt, & + I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4 + + ! local variables + + logical(kind=log_kind), dimension(nx_glob, ny_glob) :: & + G_iceumask + integer(kind=int_kind), dimension(nx_glob, ny_glob) :: & + G_icetmask + real(kind=dbl_kind), dimension(nx_glob, ny_glob) :: & + G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, G_forcey, G_Tbu, & + G_umassdti, G_fm, G_uarear, G_tarear, G_strintx, G_strinty, & + G_uvel_init, G_vvel_init, G_strength, G_uvel, G_vvel, G_dxt, & + G_dyt, G_stressp_1, G_stressp_2, G_stressp_3, G_stressp_4, & + G_stressm_1, G_stressm_2, G_stressm_3, G_stressm_4, & + G_stress12_1, G_stress12_2, G_stress12_3, G_stress12_4 + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_copyin)' + + call gather_global_ext(G_icetmask, I_icetmask, master_task, distrb_info ) + call gather_global_ext(G_iceumask, I_iceumask, master_task, distrb_info ) + call gather_global_ext(G_cdn_ocn, I_cdn_ocn, master_task, distrb_info ) + call gather_global_ext(G_aiu, I_aiu, master_task, distrb_info ) + call gather_global_ext(G_uocn, I_uocn, master_task, distrb_info ) + call gather_global_ext(G_vocn, I_vocn, master_task, distrb_info ) + call gather_global_ext(G_forcex, I_forcex, master_task, distrb_info ) + call gather_global_ext(G_forcey, I_forcey, master_task, distrb_info ) + call gather_global_ext(G_Tbu, I_Tbu, master_task, distrb_info ) + call gather_global_ext(G_umassdti, I_umassdti, master_task, distrb_info ) + call gather_global_ext(G_fm, I_fm, master_task, distrb_info ) + call gather_global_ext(G_uarear, I_uarear, master_task, distrb_info ) + call gather_global_ext(G_tarear, I_tarear, master_task, distrb_info ) + call gather_global_ext(G_strintx, I_strintx, master_task, distrb_info ) + call gather_global_ext(G_strinty, I_strinty, master_task, distrb_info ) + call gather_global_ext(G_uvel_init, I_uvel_init, master_task, distrb_info ) + call gather_global_ext(G_vvel_init, I_vvel_init, master_task, distrb_info ) + call gather_global_ext(G_strength, I_strength, master_task, distrb_info ) + call gather_global_ext(G_uvel, I_uvel, master_task, distrb_info, c0) + call gather_global_ext(G_vvel, I_vvel, master_task, distrb_info, c0) + call gather_global_ext(G_dxt, I_dxt, master_task, distrb_info ) + call gather_global_ext(G_dyt, I_dyt, master_task, distrb_info ) + call gather_global_ext(G_stressp_1, I_stressp_1, master_task, distrb_info ) + call gather_global_ext(G_stressp_2, I_stressp_2, master_task, distrb_info ) + call gather_global_ext(G_stressp_3, I_stressp_3, master_task, distrb_info ) + call gather_global_ext(G_stressp_4, I_stressp_4, master_task, distrb_info ) + call gather_global_ext(G_stressm_1, I_stressm_1, master_task, distrb_info ) + call gather_global_ext(G_stressm_2, I_stressm_2, master_task, distrb_info ) + call gather_global_ext(G_stressm_3, I_stressm_3, master_task, distrb_info ) + call gather_global_ext(G_stressm_4, I_stressm_4, master_task, distrb_info ) + call gather_global_ext(G_stress12_1, I_stress12_1, master_task, distrb_info ) + call gather_global_ext(G_stress12_2, I_stress12_2, master_task, distrb_info ) + call gather_global_ext(G_stress12_3, I_stress12_3, master_task, distrb_info ) + call gather_global_ext(G_stress12_4, I_stress12_4, master_task, distrb_info ) + + ! all calculations id done on master task + if (my_task == master_task) then + ! find number of active points and allocate 1D vectors + call calc_na(nx_glob, ny_glob, NA_len, G_icetmask, G_iceumask) + call alloc1d(NA_len) + call calc_2d_indices(nx_glob, ny_glob, NA_len, G_icetmask, G_iceumask) + call calc_navel(nx_glob, ny_glob, NA_len, NAVEL_len) + call alloc1d_navel(NAVEL_len) + ! initialize OpenMP. FIXME: ought to be called from main + call domp_init() + !$OMP PARALLEL DEFAULT(shared) + call numainit(1, NA_len, NAVEL_len) + !$OMP END PARALLEL + ! map 2D arrays to 1D arrays + call convert_2d_1d(nx_glob, ny_glob, NA_len, NAVEL_len, & + G_HTE, G_HTN, G_cdn_ocn, G_aiu, G_uocn, G_vocn, G_forcex, & + G_forcey, G_Tbu, G_umassdti, G_fm, G_uarear, G_tarear, & + G_strintx, G_strinty, G_uvel_init, G_vvel_init, & + G_strength, G_uvel, G_vvel, G_dxt, G_dyt, G_stressp_1, & + G_stressp_2, G_stressp_3, G_stressp_4, G_stressm_1, & + G_stressm_2, G_stressm_3, G_stressm_4, G_stress12_1, & + G_stress12_2, G_stress12_3, G_stress12_4) + call calc_halo_parent(nx_glob, ny_glob, NA_len, NAVEL_len, G_icetmask) + end if + + end subroutine ice_dyn_evp_1d_copyin + +!======================================================================= + + subroutine ice_dyn_evp_1d_copyout(nx, ny, nblk, nx_glob, ny_glob, & + I_uvel, I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, I_shear, I_taubx, & + I_tauby) + + use ice_constants, only : c0 + use ice_gather_scatter, only : scatter_global_ext + use ice_domain, only : distrb_info + use ice_communicate, only : my_task, master_task + + implicit none + + integer(int_kind), intent(in) :: nx, ny, nblk, nx_glob, ny_glob + real(dbl_kind), dimension(nx, ny, nblk), intent(out) :: I_uvel, & + I_vvel, I_strintx, I_strinty, I_stressp_1, I_stressp_2, & + I_stressp_3, I_stressp_4, I_stressm_1, I_stressm_2, & + I_stressm_3, I_stressm_4, I_stress12_1, I_stress12_2, & + I_stress12_3, I_stress12_4, I_divu, I_rdg_conv, I_rdg_shear, & + I_shear, I_taubx, I_tauby + + ! local variables + + integer(int_kind) :: iw, lo, up, j, i + real(dbl_kind), dimension(nx_glob, ny_glob) :: G_uvel, G_vvel, & + G_strintx, G_strinty, G_stressp_1, G_stressp_2, G_stressp_3, & + G_stressp_4, G_stressm_1, G_stressm_2, G_stressm_3, & + G_stressm_4, G_stress12_1, G_stress12_2, G_stress12_3, & + G_stress12_4, G_divu, G_rdg_conv, G_rdg_shear, G_shear, & + G_taubx, G_tauby + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_copyout)' + + ! remap 1D arrays into 2D arrays + if (my_task == master_task) then + + G_uvel = c0 + G_vvel = c0 + G_strintx = c0 + G_strinty = c0 + G_stressp_1 = c0 + G_stressp_2 = c0 + G_stressp_3 = c0 + G_stressp_4 = c0 + G_stressm_1 = c0 + G_stressm_2 = c0 + G_stressm_3 = c0 + G_stressm_4 = c0 + G_stress12_1 = c0 + G_stress12_2 = c0 + G_stress12_3 = c0 + G_stress12_4 = c0 + G_divu = c0 + G_rdg_conv = c0 + G_rdg_shear = c0 + G_shear = c0 + G_taubx = c0 + G_tauby = c0 + + !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) + call domp_get_domain(1, NA_len, lo, up) + do iw = lo, up + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! remap + G_strintx(i, j) = strintx(iw) + G_strinty(i, j) = strinty(iw) + G_stressp_1(i, j) = stressp_1(iw) + G_stressp_2(i, j) = stressp_2(iw) + G_stressp_3(i, j) = stressp_3(iw) + G_stressp_4(i, j) = stressp_4(iw) + G_stressm_1(i, j) = stressm_1(iw) + G_stressm_2(i, j) = stressm_2(iw) + G_stressm_3(i, j) = stressm_3(iw) + G_stressm_4(i, j) = stressm_4(iw) + G_stress12_1(i, j) = stress12_1(iw) + G_stress12_2(i, j) = stress12_2(iw) + G_stress12_3(i, j) = stress12_3(iw) + G_stress12_4(i, j) = stress12_4(iw) + G_divu(i, j) = divu(iw) + G_rdg_conv(i, j) = rdg_conv(iw) + G_rdg_shear(i, j) = rdg_shear(iw) + G_shear(i, j) = shear(iw) + G_taubx(i, j) = taubx(iw) + G_tauby(i, j) = tauby(iw) + G_uvel(i, j) = uvel(iw) + G_vvel(i, j) = vvel(iw) + end do + call domp_get_domain(NA_len + 1, NAVEL_len, lo, up) + do iw = lo, up + ! get 2D indices + j = int((indij(iw) - 1) / (nx_glob)) + 1 + i = indij(iw) - (j - 1) * nx_glob + ! remap + G_uvel(i, j) = uvel(iw) + G_vvel(i, j) = vvel(iw) + end do + !$OMP END PARALLEL + + call dealloc1d() + + end if + + ! scatter data on all tasks + call scatter_global_ext(I_uvel, G_uvel, master_task, distrb_info) + call scatter_global_ext(I_vvel, G_vvel, master_task, distrb_info) + call scatter_global_ext(I_strintx, G_strintx, master_task, distrb_info) + call scatter_global_ext(I_strinty, G_strinty, master_task, distrb_info) + call scatter_global_ext(I_stressp_1, G_stressp_1, master_task, distrb_info) + call scatter_global_ext(I_stressp_2, G_stressp_2, master_task, distrb_info) + call scatter_global_ext(I_stressp_3, G_stressp_3, master_task, distrb_info) + call scatter_global_ext(I_stressp_4, G_stressp_4, master_task, distrb_info) + call scatter_global_ext(I_stressm_1, G_stressm_1, master_task, distrb_info) + call scatter_global_ext(I_stressm_2, G_stressm_2, master_task, distrb_info) + call scatter_global_ext(I_stressm_3, G_stressm_3, master_task, distrb_info) + call scatter_global_ext(I_stressm_4, G_stressm_4, master_task, distrb_info) + call scatter_global_ext(I_stress12_1, G_stress12_1, master_task, distrb_info) + call scatter_global_ext(I_stress12_2, G_stress12_2, master_task, distrb_info) + call scatter_global_ext(I_stress12_3, G_stress12_3, master_task, distrb_info) + call scatter_global_ext(I_stress12_4, G_stress12_4, master_task, distrb_info) + call scatter_global_ext(I_divu, G_divu, master_task, distrb_info) + call scatter_global_ext(I_rdg_conv, G_rdg_conv, master_task, distrb_info) + call scatter_global_ext(I_rdg_shear, G_rdg_shear, master_task, distrb_info) + call scatter_global_ext(I_shear, G_shear, master_task, distrb_info) + call scatter_global_ext(I_taubx, G_taubx, master_task, distrb_info) + call scatter_global_ext(I_tauby, G_tauby, master_task, distrb_info) + + end subroutine ice_dyn_evp_1d_copyout + +!======================================================================= + + subroutine ice_dyn_evp_1d_kernel + + use ice_constants, only : c0 + use ice_dyn_shared, only : ndte + use ice_communicate, only : my_task, master_task + + implicit none + + ! local variables + + real(kind=dbl_kind) :: rhow + integer(kind=int_kind) :: ksub + + character(len=*), parameter :: & + subname = '(ice_dyn_evp_1d_kernel)' + + ! all calculations is done on master task + if (my_task == master_task) then + + ! read constants + call icepack_query_parameters(rhow_out = rhow) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) then + call abort_ice(error_message=subname, file=__FILE__, & + line=__LINE__) + end if + + if (ndte < 2) call abort_ice(subname & + // ' ERROR: ndte must be 2 or higher for this kernel') + + !$OMP PARALLEL PRIVATE(ksub) + do ksub = 1, ndte - 1 + call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, & + vvel, dxt, dyt, hte, htn, htem1, htnm1, strength, & + stressp_1, stressp_2, stressp_3, stressp_4, stressm_1, & + stressm_2, stressm_3, stressm_4, stress12_1, & + stress12_2, stress12_3, stress12_4, str1, str2, str3, & + str4, str5, str6, str7, str8, skiptcell) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, & + uocn, vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & + uvel_init, vvel_init, uvel, vvel, str1, str2, str3, & + str4, str5, str6, str7, str8, nw, sw, sse, skipucell) + !$OMP BARRIER + call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & + halo_parent) + !$OMP BARRIER + end do + + call evp1d_stress(NA_len, ee, ne, se, 1, NA_len, uvel, vvel, & + dxt, dyt, hte, htn, htem1, htnm1, strength, stressp_1, & + stressp_2, stressp_3, stressp_4, stressm_1, stressm_2, & + stressm_3, stressm_4, stress12_1, stress12_2, stress12_3, & + stress12_4, str1, str2, str3, str4, str5, str6, str7, & + str8, skiptcell, tarear, divu, rdg_conv, rdg_shear, shear) + !$OMP BARRIER + call evp1d_stepu(NA_len, rhow, 1, NA_len, cdn_ocn, aiu, uocn, & + vocn, forcex, forcey, umassdti, fm, uarear, Tbu, & + uvel_init, vvel_init, uvel, vvel, str1, str2, str3, str4, & + str5, str6, str7, str8, nw, sw, sse, skipucell, strintx, & + strinty, taubx, tauby) + !$OMP BARRIER + call evp1d_halo_update(NAVEL_len, 1, NA_len, uvel, vvel, & + halo_parent) + !$OMP END PARALLEL + + end if ! master task + + end subroutine ice_dyn_evp_1d_kernel + +!======================================================================= + + subroutine calc_na(nx, ny, na, icetmask, iceumask) + ! Calculate number of active points + + use ice_blocks, only : nghost + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + icetmask + logical(kind=log_kind), dimension(nx, ny), intent(in) :: & + iceumask + integer(kind=int_kind), intent(out) :: na + + ! local variables + + integer(kind=int_kind) :: i, j + + character(len=*), parameter :: subname = '(calc_na)' + + na = 0 + ! NOTE: T mask includes northern and eastern ghost cells + do j = 1 + nghost, ny + do i = 1 + nghost, nx + if (icetmask(i,j) == 1 .or. iceumask(i,j)) na = na + 1 + end do + end do + + end subroutine calc_na + +!======================================================================= + + subroutine calc_2d_indices(nx, ny, na, icetmask, iceumask) + + use ice_blocks, only : nghost + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny, na + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + icetmask + logical(kind=log_kind), dimension(nx, ny), intent(in) :: & + iceumask + + ! local variables + + integer(kind=int_kind) :: i, j, Nmaskt + + character(len=*), parameter :: subname = '(calc_2d_indices)' + + skipucell(:) = .false. + skiptcell(:) = .false. + indi = 0 + indj = 0 + Nmaskt = 0 + ! NOTE: T mask includes northern and eastern ghost cells + do j = 1 + nghost, ny + do i = 1 + nghost, nx + if (icetmask(i,j) == 1 .or. iceumask(i,j)) then + Nmaskt = Nmaskt + 1 + indi(Nmaskt) = i + indj(Nmaskt) = j + if (icetmask(i,j) /= 1) skiptcell(Nmaskt) = .true. + if (.not. iceumask(i,j)) skipucell(Nmaskt) = .true. + ! NOTE: U mask does not include northern and eastern + ! ghost cells. Skip northern and eastern ghost cells + if (i == nx) skipucell(Nmaskt) = .true. + if (j == ny) skipucell(Nmaskt) = .true. + end if + end do + end do + + end subroutine calc_2d_indices + +!======================================================================= + + subroutine calc_navel(nx_block, ny_block, na, navel) + ! Calculate number of active points, including halo points + + implicit none + + integer(kind=int_kind), intent(in) :: nx_block, ny_block, na + integer(kind=int_kind), intent(out) :: navel + + ! local variables + + integer(kind=int_kind) :: iw, i, j + integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & + Inw, Isw, Isse + integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 + + character(len=*), parameter :: subname = '(calc_navel)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx_block ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx_block ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx_block ! (-1, -1) + Ise(iw) = i + (j - 2) * nx_block ! ( 0, -1) + Inw(iw) = i + 1 + (j - 1) * nx_block ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx_block ! (+1, +1) + Isse(iw) = i + (j - 0) * nx_block ! ( 0, +1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin, Iee, na, na, util1, i ) + call union(util1, Ine, i, na, util2, j ) + call union(util2, Ise, j, na, util1, i ) + call union(util1, Inw, i, na, util2, j ) + call union(util2, Isw, j, na, util1, i ) + call union(util1, Isse, i, na, util2, navel) + + end subroutine calc_navel + +!======================================================================= + + subroutine convert_2d_1d(nx, ny, na, navel, I_HTE, I_HTN, & + I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, I_Tbu, & + I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, I_strinty, & + I_uvel_init, I_vvel_init, I_strength, I_uvel, I_vvel, I_dxt, & + I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, I_stressp_4, & + I_stressm_1, I_stressm_2, I_stressm_3, I_stressm_4, & + I_stress12_1, I_stress12_2, I_stress12_3, I_stress12_4) + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny, na, navel + real (kind=dbl_kind), dimension(nx, ny), intent(in) :: I_HTE, & + I_HTN, I_cdn_ocn, I_aiu, I_uocn, I_vocn, I_forcex, I_forcey, & + I_Tbu, I_umassdti, I_fm, I_uarear, I_tarear, I_strintx, & + I_strinty, I_uvel_init, I_vvel_init, I_strength, I_uvel, & + I_vvel, I_dxt, I_dyt, I_stressp_1, I_stressp_2, I_stressp_3, & + I_stressp_4, I_stressm_1, I_stressm_2, I_stressm_3, & + I_stressm_4, I_stress12_1, I_stress12_2, I_stress12_3, & + I_stress12_4 + + ! local variables + + integer(kind=int_kind) :: iw, lo, up, j, i, nachk + integer(kind=int_kind), dimension(1:na) :: Iin, Iee, Ine, Ise, & + Inw, Isw, Isse + integer(kind=int_kind), dimension(1:7 * na) :: util1, util2 + + character(len=*), parameter :: subname = '(convert_2d_1d)' + + ! calculate additional 1D indices used for finite differences + do iw = 1, na + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! calculate 1D indices + Iin(iw) = i + (j - 1) * nx ! ( 0, 0) target point + Iee(iw) = i - 1 + (j - 1) * nx ! (-1, 0) + Ine(iw) = i - 1 + (j - 2) * nx ! (-1,-1) + Ise(iw) = i + (j - 2) * nx ! ( 0,-1) + Inw(iw) = i + 1 + (j - 1) * nx ! (+1, 0) + Isw(iw) = i + 1 + (j - 0) * nx ! (+1,+1) + Isse(iw) = i + (j - 0) * nx ! ( 0,+1) + end do + + ! find number of points needed for finite difference calculations + call union(Iin, Iee, na, na, util1, i ) + call union(util1, Ine, i, na, util2, j ) + call union(util2, Ise, j, na, util1, i ) + call union(util1, Inw, i, na, util2, j ) + call union(util2, Isw, j, na, util1, i ) + call union(util1, Isse, i, na, util2, nachk) + + ! index vector with sorted target points + do iw = 1, na + indij(iw) = Iin(iw) + end do + + ! sorted additional points + call setdiff(util2, Iin, navel, na, util1, j) + do iw = na + 1, navel + indij(iw) = util1(iw - na) + end do + + ! indices for additional points needed for uvel and vvel + call findXinY(Iee, indij, na, navel, ee) + call findXinY(Ine, indij, na, navel, ne) + call findXinY(Ise, indij, na, navel, se) + call findXinY(Inw, indij, na, navel, nw) + call findXinY(Isw, indij, na, navel, sw) + call findXinY(Isse, indij, na, navel, sse) + + !$OMP PARALLEL PRIVATE(iw, lo, up, j, i) + ! write 1D arrays from 2D arrays (target points) + call domp_get_domain(1, na, lo, up) + do iw = lo, up + ! get 2D indices + i = indi(iw) + j = indj(iw) + ! map + uvel(iw) = I_uvel(i, j) + vvel(iw) = I_vvel(i, j) + cdn_ocn(iw) = I_cdn_ocn(i, j) + aiu(iw) = I_aiu(i, j) + uocn(iw) = I_uocn(i, j) + vocn(iw) = I_vocn(i, j) + forcex(iw) = I_forcex(i, j) + forcey(iw) = I_forcey(i, j) + Tbu(iw) = I_Tbu(i, j) + umassdti(iw) = I_umassdti(i, j) + fm(iw) = I_fm(i, j) + tarear(iw) = I_tarear(i, j) + uarear(iw) = I_uarear(i, j) + strintx(iw) = I_strintx(i, j) + strinty(iw) = I_strinty(i, j) + uvel_init(iw) = I_uvel_init(i, j) + vvel_init(iw) = I_vvel_init(i, j) + strength(iw) = I_strength(i, j) + dxt(iw) = I_dxt(i, j) + dyt(iw) = I_dyt(i, j) + stressp_1(iw) = I_stressp_1(i, j) + stressp_2(iw) = I_stressp_2(i, j) + stressp_3(iw) = I_stressp_3(i, j) + stressp_4(iw) = I_stressp_4(i, j) + stressm_1(iw) = I_stressm_1(i, j) + stressm_2(iw) = I_stressm_2(i, j) + stressm_3(iw) = I_stressm_3(i, j) + stressm_4(iw) = I_stressm_4(i, j) + stress12_1(iw) = I_stress12_1(i, j) + stress12_2(iw) = I_stress12_2(i, j) + stress12_3(iw) = I_stress12_3(i, j) + stress12_4(iw) = I_stress12_4(i, j) + HTE(iw) = I_HTE(i, j) + HTN(iw) = I_HTN(i, j) + HTEm1(iw) = I_HTE(i - 1, j) + HTNm1(iw) = I_HTN(i, j - 1) + end do + ! write 1D arrays from 2D arrays (additional points) + call domp_get_domain(na + 1, navel, lo, up) + do iw = lo, up + ! get 2D indices + j = int((indij(iw) - 1) / (nx)) + 1 + i = indij(iw) - (j - 1) * nx + ! map + uvel(iw) = I_uvel(i, j) + vvel(iw) = I_vvel(i, j) + end do !$OMP END PARALLEL - endif - - end subroutine evp_kernel_v2 - -!---------------------------------------------------------------------------- - - subroutine calc_na(nx,ny,na,icetmask) - ! Calculate number of active points (na) - use ice_blocks, only: nghost - - implicit none - - integer(int_kind),intent(in) :: nx,ny - integer(int_kind),intent(out) :: na - integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask - integer(int_kind) :: i,j - - character(len=*), parameter :: subname = '(calc_na)' - !--------------------------------------- - - na = 0 -! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) - do j = 1+nghost, ny ! -nghost - do i = 1+nghost, nx ! -nghost - if (icetmask(i,j)==1) then - na=na+1 - endif - enddo - enddo - - end subroutine calc_na - -!---------------------------------------------------------------------------- - - subroutine calc_2d_indices(nx,ny,na,icetmask,iceumask) - - use ice_blocks, only: nghost - - implicit none - - integer(int_kind),intent(in) :: nx,ny,na - integer (kind=int_kind),dimension (nx,ny), intent(in) :: icetmask - logical (kind=log_kind),dimension (nx,ny), intent(in) :: iceumask - integer(int_kind) :: i,j,Nmaskt - - character(len=*), parameter :: subname = '(calc_2d_indices)' - !--------------------------------------- - - skipucell(:)=.false. - indi=0 - indj=0 - Nmaskt=0 -! Note: The icellt mask includes north and east ghost cells. (ice_dyn_shared.F90) - do j = 1+nghost, ny ! -nghost - do i = 1+nghost, nx ! -nghost - if (icetmask(i,j)==1) then - Nmaskt=Nmaskt+1 - indi(Nmaskt) = i - indj(Nmaskt) = j - ! Umask do NOT include north/east ghost cells ... skip these as well - if (iceumask(i,j) .eqv. .false. ) skipucell(Nmaskt) = .true. - if (i==nx) skipucell(Nmaskt) = .true. - if (j==ny) skipucell(Nmaskt) = .true. - endif - enddo - enddo - if (Nmaskt.ne.na) then - write(nu_diag,*) subname,' Nmaskt,na: ',Nmaskt,na - call abort_ice(subname//': ERROR Problem Nmaskt != na') - endif - if (Nmaskt==0) then - write(nu_diag,*) subname,' WARNING: NO ICE' - endif - - end subroutine calc_2d_indices - -!---------------------------------------------------------------------------- - - subroutine calc_navel(nx_block,ny_block,na,navel) - ! Calculate number of active points including needed halo points (navel) - - implicit none - - integer(int_kind),intent(in) :: nx_block,ny_block,na - integer(int_kind),intent(out) :: navel - - integer(int_kind) :: iw,i,j - integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse - integer(int_kind),dimension(1:7*na) :: util1,util2 - - character(len=*), parameter :: subname = '(calc_navel)' - - !--------------------------------------- - ! Additional indices used for finite differences (FD) - do iw=1,na - i=indi(iw) - j=indj(iw) - Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point - Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) - Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) - Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) - Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) - Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) - Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) - enddo - - !-- Find number of points needed for finite difference calculations - call union(Iin, Iee,na,na,util1,i) - call union(util1,Ine, i,na,util2,j) - call union(util2,Ise, j,na,util1,i) - call union(util1,Inw, i,na,util2,j) - call union(util2,Isw, j,na,util1,i) - call union(util1,Isse,i,na,util2,navel) - - !-- Check bounds - do iw=1,navel - if (util2(iw)>nx_block*ny_block .or. util2(iw)<1) then - write(nu_diag,*) subname,' nx_block,ny_block,nx_block*ny_block: ',nx_block,ny_block,nx_block*ny_block - write(nu_diag,*) subname,' na,navel,iw,util2(iw): ',na,navel,iw,util2(iw) - call abort_ice(subname//': Problem with boundary. Check halo zone values') - endif - enddo - - end subroutine calc_navel - -!---------------------------------------------------------------------------- - - subroutine convert_2d_1d_v2(nx,ny, na,navel, & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & - I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 ) - - implicit none - - integer(int_kind),intent(in) :: nx,ny,na,navel - real (kind=dbl_kind), dimension(nx,ny), intent(in) :: & - I_HTE,I_HTN, & -!v1 I_dxhy,I_dyhx,I_cyp,I_cxp,I_cym,I_cxm,I_tinyarea, & -!v1 I_waterx,I_watery, & - I_cdn_ocn,I_aiu,I_uocn,I_vocn,I_forcex,I_forcey,I_Tbu, & - I_umassdti,I_fm,I_uarear,I_tarear,I_strintx,I_strinty, & - I_uvel_init,I_vvel_init, & - I_strength,I_uvel,I_vvel,I_dxt,I_dyt, & - I_stressp_1 ,I_stressp_2, I_stressp_3, I_stressp_4, & - I_stressm_1 ,I_stressm_2, I_stressm_3, I_stressm_4, & - I_stress12_1,I_stress12_2,I_stress12_3,I_stress12_4 - - integer(int_kind) :: iw,i,j, nx_block - integer(int_kind),dimension(1:na) :: Iin,Iee,Ine,Ise,Inw,Isw,Isse - integer(int_kind),dimension(1:7*na) :: util1,util2 - integer(int_kind) :: nachk - - character(len=*), parameter :: subname = '(convert_2d_1d_v2)' - - !--------------------------------------- - ! Additional indices used for finite differences (FD) - nx_block=nx ! Total block size in x-dir - do iw=1,na - i=indi(iw) - j=indj(iw) - Iin(iw) = i + (j-1)*nx_block ! ( 0, 0) Target point - Iee(iw) = i-1 + (j-1)*nx_block ! (-1, 0) - Ine(iw) = i-1 + (j-2)*nx_block ! (-1,-1) - Ise(iw) = i + (j-2)*nx_block ! ( 0,-1) - Inw(iw) = i+1 + (j-1)*nx_block ! (+1, 0) - Isw(iw) = i+1 + (j-0)*nx_block ! (+1,+1) - Isse(iw)= i + (j-0)*nx_block ! ( 0,+1) - enddo - - !-- Find number of points needed for finite difference calculations - call union(Iin, Iee,na,na,util1,i) - call union(util1,Ine, i,na,util2,j) - call union(util2,Ise, j,na,util1,i) - call union(util1,Inw, i,na,util2,j) - call union(util2,Isw, j,na,util1,i) - call union(util1,Isse,i,na,util2,nachk) - - if (nachk .ne. navel) then - write(nu_diag,*) subname,' ERROR: navel badly chosen: na,navel,nachk = ',na,navel,nachk - call abort_ice(subname//': ERROR: navel badly chosen') - endif - - ! indij: vector with target points (sorted) ... - do iw=1,na - indij(iw)=Iin(iw) - enddo - - ! indij: ... followed by extra points (sorted) - call setdiff(util2,Iin,navel,na,util1,j) - do iw=na+1,navel - indij(iw)=util1(iw-na) - enddo - - !-- Create indices for additional points needed for uvel,vvel: - call findXinY(Iee ,indij,na,navel, ee) - call findXinY(Ine ,indij,na,navel, ne) - call findXinY(Ise ,indij,na,navel, se) - call findXinY(Inw ,indij,na,navel, nw) - call findXinY(Isw ,indij,na,navel, sw) - call findXinY(Isse,indij,na,navel,sse) - - !-- write check -!if (1 == 2) then -! write(nu_diag,*) subname,' MHRI: INDICES start:' -! write(nu_diag,*) 'Min/max ee', minval(ee), maxval(ee) -! write(nu_diag,*) 'Min/max ne', minval(ne), maxval(ne) -! write(nu_diag,*) 'Min/max se', minval(se), maxval(se) -! write(nu_diag,*) 'Min/max nw', minval(nw), maxval(nw) -! write(nu_diag,*) 'Min/max sw', minval(sw), maxval(sw) -! write(nu_diag,*) 'Min/max sse',minval(sse),maxval(sse) -! write(nu_diag,*) subname,' MHRI: INDICES end:' -!endif - - ! Write 1D data from 2D: Here only extra FD part, the rest follows... - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=na+1,navel - j=int((indij(iw)-1)/(nx_block))+1 - i=indij(iw)-(j-1)*nx_block - uvel(iw)= I_uvel(i,j) - vvel(iw)= I_vvel(i,j) - enddo - !$OMP END PARALLEL DO - - ! Write 1D data from 2D - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=1,na - i=indi(iw) - j=indj(iw) - uvel(iw)= I_uvel(i,j) - vvel(iw)= I_vvel(i,j) - cdn_ocn(iw)= I_cdn_ocn(i,j) - aiu(iw)= I_aiu(i,j) - uocn(iw)= I_uocn(i,j) - vocn(iw)= I_vocn(i,j) - forcex(iw)= I_forcex(i,j) - forcey(iw)= I_forcey(i,j) - Tbu(iw)= I_Tbu(i,j) - umassdti(iw)= I_umassdti(i,j) - fm(iw)= I_fm(i,j) - tarear(iw)= I_tarear(i,j) - uarear(iw)= I_uarear(i,j) - strintx(iw)= I_strintx(i,j) - strinty(iw)= I_strinty(i,j) - uvel_init(iw)= I_uvel_init(i,j) - vvel_init(iw)= I_vvel_init(i,j) - strength(iw)= I_strength(i,j) - dxt(iw)= I_dxt(i,j) - dyt(iw)= I_dyt(i,j) - stressp_1(iw)= I_stressp_1(i,j) - stressp_2(iw)= I_stressp_2(i,j) - stressp_3(iw)= I_stressp_3(i,j) - stressp_4(iw)= I_stressp_4(i,j) - stressm_1(iw)= I_stressm_1(i,j) - stressm_2(iw)= I_stressm_2(i,j) - stressm_3(iw)= I_stressm_3(i,j) - stressm_4(iw)= I_stressm_4(i,j) - stress12_1(iw)=I_stress12_1(i,j) - stress12_2(iw)=I_stress12_2(i,j) - stress12_3(iw)=I_stress12_3(i,j) - stress12_4(iw)=I_stress12_4(i,j) -!v1 dxhy(iw)= I_dxhy(i,j) -!v1 dyhx(iw)= I_dyhx(i,j) -!v1 cyp(iw)= I_cyp(i,j) -!v1 cxp(iw)= I_cxp(i,j) -!v1 cym(iw)= I_cym(i,j) -!v1 cxm(iw)= I_cxm(i,j) -!v1 tinyarea(iw)= I_tinyarea(i,j) -!v1 waterx(iw)= I_waterx(i,j) -!v1 watery(iw)= I_watery(i,j) - HTE(iw) = I_HTE(i,j) - HTN(iw) = I_HTN(i,j) - HTEm1(iw) = I_HTE(i-1,j) - HTNm1(iw) = I_HTN(i,j-1) - enddo - !$OMP END PARALLEL DO - - end subroutine convert_2d_1d_v2 - -!---------------------------------------------------------------------------- - - subroutine calc_halo_parent(nx,ny,na,navel, I_icetmask) - - implicit none - - integer(kind=int_kind),intent(in) :: nx,ny,na,navel - integer(kind=int_kind), dimension(nx,ny), intent(in) :: I_icetmask - - integer(kind=int_kind) :: iw,i,j !,masku,maskt - integer(kind=int_kind),dimension(1:navel) :: Ihalo - - character(len=*), parameter :: subname = '(calc_halo_parent)' - - !--------------------------------------- - ! Indices for halo update: - ! 0: no halo point - ! >0: index for halo point parent. Finally related to indij vector - ! TODO: ONLY for nghost==1 - ! TODO: ONLY for circular grids - NOT tripole grids - - Ihalo(:)=0 - halo_parent(:)=0 - - !$OMP PARALLEL DO PRIVATE(iw,i,j) - do iw=1,navel - j=int((indij(iw)-1)/(nx))+1 - i=indij(iw)-(j-1)*nx - ! If within ghost-zone: - if (i==nx .and. I_icetmask( 2,j)==1) Ihalo(iw)= 2+ (j-1)*nx - if (i==1 .and. I_icetmask(nx-1,j)==1) Ihalo(iw)=(nx-1)+ (j-1)*nx - if (j==ny .and. I_icetmask(i, 2)==1) Ihalo(iw)= i+ nx - if (j==1 .and. I_icetmask(i,ny-1)==1) Ihalo(iw)= i+(ny-2)*nx - enddo - !$OMP END PARALLEL DO - - ! Relate halo indices to indij vector - call findXinY_halo(Ihalo,indij,navel,navel,halo_parent) - - !-- write check -!if (1 == 1) then -! integer(kind=int_kind) :: iiw,ii,jj !,masku,maskt MHRI -! write(nu_diag,*) subname,' MHRI: halo boundary start:' -! do iw=1,navel -! if (halo_parent(iw)>0) then -! iiw=halo_parent(iw) -! j=int((indij(iiw)-1)/(nx))+1 -! i=indij(iiw)-(j-1)*nx -! ii=i -! jj=j -! j=int((indij(iw)-1)/(nx))+1 -! i=indij(iw)-(j-1)*nx -! write(nu_diag,*)iw,i,j,iiw,ii,jj -! endif -! enddo -! write(nu_diag,*) subname,' MHRI: halo boundary end:' -!endif - - end subroutine calc_halo_parent - -!---------------------------------------------------------------------------- - - subroutine union(x,y,nx,ny,xy,nxy) - ! Find union (xy) of two sorted integer vectors (x and y) - ! ie. Combined values of the two vectors with no repetitions. - !use ice_kinds_mod - - implicit none - - integer (int_kind) :: i,j,k - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: xy(1:nx+ny) - integer (int_kind),intent(out) :: nxy - - character(len=*), parameter :: subname = '(union)' - - !--------------------------------------- - - i=1 - j=1 - k=1 - do while (i<=nx .and. j<=ny) - if (x(i)y(j)) then - xy(k)=y(j) - j=j+1 - else !if (x(i)==y(j)) then - xy(k)=x(i) - i=i+1 - j=j+1 - endif - k=k+1 - enddo - - ! The rest - do while (i<=nx) - xy(k)=x(i) - i=i+1 - k=k+1 - enddo - do while (j<=ny) - xy(k)=y(j) - j=j+1 - k=k+1 - enddo - nxy=k-1 - - end subroutine union - -!---------------------------------------------------------------------------- - - subroutine setdiff(x,y,nx,ny,xy,nxy) - ! Find element (xy) of two sorted integer vectors (x and y) - ! that are in x, but not in y ... or in y, but not in x - !use ice_kinds_mod - - implicit none - - integer (int_kind) :: i,j,k - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: xy(1:nx+ny) - integer (int_kind),intent(out) :: nxy - - character(len=*), parameter :: subname = '(setdiff)' - !--------------------------------------- - - i=1 - j=1 - k=1 - do while (i<=nx .and. j<=ny) - if (x(i)y(j)) then - xy(k)=y(j) - j=j+1 - k=k+1 - else !if (x(i)==y(j)) then - i=i+1 - j=j+1 - endif - enddo - - ! The rest - do while (i<=nx) - xy(k)=x(i) - i=i+1 - k=k+1 - enddo - do while (j<=ny) - xy(k)=y(j) - j=j+1 - k=k+1 - enddo - nxy=k-1 - - end subroutine setdiff - -!---------------------------------------------------------------------------- - - subroutine findXinY(x,y,nx,ny,indx) - ! Find indx vector so that x(1:na)=y(indx(1:na)) - ! - ! Conditions: - ! * EVERY item in x is found in y. - ! * x(1:nx) is a sorted integer vector. - ! * y(1:ny) consists of two sorted integer vectors: - ! [y(1:nx) ; y(nx+1:ny)] - ! * ny>=nx - ! Return: indx(1:na) - ! - !use ice_kinds_mod - - implicit none - - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: indx(1:nx) - integer (int_kind) :: i,j1,j2 - - character(len=*), parameter :: subname = '(findXinY)' - !--------------------------------------- - - i=1 - j1=1 - j2=nx+1 - do while (i<=nx) - if (x(i)==y(j1)) then - indx(i)=j1 - i=i+1 - j1=j1+1 - else if (x(i)==y(j2)) then - indx(i)=j2 - i=i+1 - j2=j2+1 - else if (x(i)>y(j1) ) then !.and. j1y(j2) ) then !.and. j2=nx - ! Return: indx(1:na) - ! - !use ice_kinds_mod - - implicit none - - integer (int_kind),intent(in) :: nx,ny - integer (int_kind),intent(in) :: x(1:nx),y(1:ny) - integer (int_kind),intent(out) :: indx(1:nx) - integer (int_kind) :: i,j1,nloop - - character(len=*), parameter :: subname = '(findXinY_halo)' - !--------------------------------------- - - nloop=1 - i=1 - j1=int((ny+1)/2) ! initial guess in the middle - do while (i<=nx) - if (x(i)==0) then - indx(i)=0 - i=i+1 - nloop=1 - else if (x(i)==y(j1)) then - indx(i)=j1 - i=i+1 - j1=j1+1 - if (j1>ny) j1=int((ny+1)/2) ! initial guess in the middle - nloop=1 - else if (x(i)y(j1) ) then - j1=j1+1 - if (j1>ny) then - j1=1 - nloop=nloop+1 - if (nloop>2) then - ! Stop for inf. loop. This check should not be necessary for halo - write(nu_diag,*) subname,' nx,ny: ',nx,ny - write(nu_diag,*) subname,' i,j1: ',i,j1 - write(nu_diag,*) subname,' x(i),y(j1): ',x(i),y(j1) - call abort_ice(subname//': ERROR too many loops') - endif - endif - endif - end do - - end subroutine findXinY_halo - -!---------------------------------------------------------------------------- - - subroutine numainit(l,u,uu) - - use ice_constants, only: c0 - - implicit none - - integer(kind=int_kind),intent(in) :: l,u,uu - - integer(kind=int_kind) :: lo,up - - character(len=*), parameter :: subname = '(numainit)' - !--------------------------------------- - - call domp_get_domain(l,u,lo,up) - ee(lo:up)=0 - ne(lo:up)=0 - se(lo:up)=0 - sse(lo:up)=0 - nw(lo:up)=0 - sw(lo:up)=0 - halo_parent(lo:up)=0 - strength(lo:up)=c0 - uvel(lo:up)=c0 - vvel(lo:up)=c0 - uvel_init(lo:up)=c0 - vvel_init(lo:up)=c0 - uocn(lo:up)=c0 - vocn(lo:up)=c0 - dxt(lo:up)=c0 - dyt(lo:up)=c0 - HTE(lo:up)=c0 - HTN(lo:up)=c0 - HTEm1(lo:up)=c0 - HTNm1(lo:up)=c0 -!v1 dxhy(lo:up)=c0 -!v1 dyhx(lo:up)=c0 -!v1 cyp(lo:up)=c0 -!v1 cxp(lo:up)=c0 -!v1 cym(lo:up)=c0 -!v1 cxm(lo:up)=c0 -!v1 tinyarea(lo:up)=c0 - stressp_1(lo:up)=c0 - stressp_2(lo:up)=c0 - stressp_3(lo:up)=c0 - stressp_4(lo:up)=c0 - stressm_1(lo:up)=c0 - stressm_2(lo:up)=c0 - stressm_3(lo:up)=c0 - stressm_4(lo:up)=c0 - stress12_1(lo:up)=c0 - stress12_2(lo:up)=c0 - stress12_3(lo:up)=c0 - stress12_4(lo:up)=c0 - tarear(lo:up)=c0 - Tbu(lo:up)=c0 - taubx(lo:up)=c0 - tauby(lo:up)=c0 - divu(lo:up)=c0 - rdg_conv(lo:up)=c0 - rdg_shear(lo:up)=c0 - shear(lo:up)=c0 - str1(lo:up)=c0 - str2(lo:up)=c0 - str3(lo:up)=c0 - str4(lo:up)=c0 - str5(lo:up)=c0 - str6(lo:up)=c0 - str7(lo:up)=c0 - str8(lo:up)=c0 - call domp_get_domain(u+1,uu,lo,up) - halo_parent(lo:up)=0 - uvel(lo:up)=c0 - vvel(lo:up)=c0 - str1(lo:up)=c0 - str2(lo:up)=c0 - str3(lo:up)=c0 - str4(lo:up)=c0 - str5(lo:up)=c0 - str6(lo:up)=c0 - str7(lo:up)=c0 - str8(lo:up)=c0 - - end subroutine numainit - -!---------------------------------------------------------------------------- -!=============================================================================== + end subroutine convert_2d_1d -end module ice_dyn_evp_1d +!======================================================================= + + subroutine calc_halo_parent(nx, ny, na, navel, I_icetmask) + + implicit none + integer(kind=int_kind), intent(in) :: nx, ny, na, navel + integer(kind=int_kind), dimension(nx, ny), intent(in) :: & + I_icetmask + + ! local variables + + integer(kind=int_kind) :: iw, i, j + integer(kind=int_kind), dimension(1:navel) :: Ihalo + + character(len=*), parameter :: subname = '(calc_halo_parent)' + + !----------------------------------------------------------------- + ! Indices for halo update: + ! 0: no halo point + ! >0: index for halo point parent, related to indij vector + ! + ! TODO: Implement for nghost > 1 + ! TODO: Implement for tripole grids + !----------------------------------------------------------------- + + Ihalo(:) = 0 + halo_parent(:) = 0 + + do iw = 1, navel + j = int((indij(iw) - 1) / (nx)) + 1 + i = indij(iw) - (j - 1) * nx + ! if within ghost zone + if (i == nx .and. I_icetmask(2, j) == 1) Ihalo(iw) = 2 + (j - 1) * nx + if (i == 1 .and. I_icetmask(nx - 1, j) == 1) Ihalo(iw) = (nx - 1) + (j - 1) * nx + if (j == ny .and. I_icetmask(i, 2) == 1) Ihalo(iw) = i + nx + if (j == 1 .and. I_icetmask(i, ny - 1) == 1) Ihalo(iw) = i + (ny - 2) * nx + end do + + ! relate halo indices to indij vector + call findXinY_halo(Ihalo, indij, navel, navel, halo_parent) + + end subroutine calc_halo_parent + +!======================================================================= + + subroutine union(x, y, nx, ny, xy, nxy) + ! Find union (xy) of two sorted integer vectors (x and y), i.e. + ! combined values of the two vectors with no repetitions + + implicit none + + integer(int_kind), intent(in) :: nx, ny + integer(int_kind), intent(in) :: x(1:nx), y(1:ny) + integer(int_kind), intent(out) :: xy(1:nx + ny) + integer(int_kind), intent(out) :: nxy + + ! local variables + + integer(int_kind) :: i, j, k + + character(len=*), parameter :: subname = '(union)' + + i = 1 + j = 1 + k = 1 + do while (i <= nx .and. j <= ny) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + else + xy(k) = x(i) + i = i + 1 + j = j + 1 + end if + k = k + 1 + end do + + ! the rest + do while (i <= nx) + xy(k) = x(i) + i = i + 1 + k = k + 1 + end do + do while (j <= ny) + xy(k) = y(j) + j = j + 1 + k = k + 1 + end do + nxy = k - 1 + + end subroutine union + +!======================================================================= + + subroutine setdiff(x, y, nx, ny, xy, nxy) + ! Find element (xy) of two sorted integer vectors (x and y) that + ! are in x, but not in y, or in y, but not in x + + implicit none + + integer(kind=int_kind), intent(in) :: nx, ny + integer(kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer(kind=int_kind), intent(out) :: xy(1:nx + ny) + integer(kind=int_kind), intent(out) :: nxy + + ! local variables + + integer(kind=int_kind) :: i, j, k + + character(len=*), parameter :: subname = '(setdiff)' + + i = 1 + j = 1 + k = 1 + do while (i <= nx .and. j <= ny) + if (x(i) < y(j)) then + xy(k) = x(i) + i = i + 1 + k = k + 1 + else if (x(i) > y(j)) then + xy(k) = y(j) + j = j + 1 + k = k + 1 + else + i = i + 1 + j = j + 1 + end if + end do + + ! the rest + do while (i <= nx) + xy(k) = x(i) + i = i + 1 + k = k + 1 + end do + do while (j <= ny) + xy(k) = y(j) + j = j + 1 + k = k + 1 + end do + nxy = k - 1 + + end subroutine setdiff + +!======================================================================== + + subroutine findXinY(x, y, nx, ny, indx) + ! Find indx vector so that x(1:na) = y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y + ! * x(1:nx) is a sorted integer vector + ! * y(1:ny) consists of two sorted integer vectors: + ! [y(1:nx); y(nx + 1:ny)] + ! * ny >= nx + ! + ! Return: indx(1:na) + + implicit none + + integer (kind=int_kind), intent(in) :: nx, ny + integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer (kind=int_kind), intent(out) :: indx(1:nx) + + ! local variables + + integer (kind=int_kind) :: i, j1, j2 + + character(len=*), parameter :: subname = '(findXinY)' + + i = 1 + j1 = 1 + j2 = nx + 1 + do while (i <= nx) + if (x(i) == y(j1)) then + indx(i) = j1 + i = i + 1 + j1 = j1 + 1 + else if (x(i) == y(j2)) then + indx(i) = j2 + i = i + 1 + j2 = j2 + 1 + else if (x(i) > y(j1)) then + j1 = j1 + 1 + else if (x(i) > y(j2)) then + j2 = j2 + 1 + else + call abort_ice(subname & + // ': ERROR: conditions not met') + end if + end do + + end subroutine findXinY + +!======================================================================= + + subroutine findXinY_halo(x, y, nx, ny, indx) + ! Find indx vector so that x(1:na) = y(indx(1:na)) + ! + ! Conditions: + ! * EVERY item in x is found in y, + ! except for x == 0, where indx = 0 is returned + ! * x(1:nx) is a non-sorted integer vector + ! * y(1:ny) is a sorted integer vector + ! * ny >= nx + ! + ! Return: indx(1:na) + + implicit none + + integer (kind=int_kind), intent(in) :: nx, ny + integer (kind=int_kind), intent(in) :: x(1:nx), y(1:ny) + integer (kind=int_kind), intent(out) :: indx(1:nx) + + ! local variables + + integer (kind=int_kind) :: i, j1, nloop + + character(len=*), parameter :: subname = '(findXinY_halo)' + + nloop = 1 + i = 1 + j1 = int((ny + 1) / 2) ! initial guess in the middle + do while (i <= nx) + if (x(i) == 0) then + indx(i) = 0 + i = i + 1 + nloop = 1 + else if (x(i) == y(j1)) then + indx(i) = j1 + i = i + 1 + j1 = j1 + 1 + ! initial guess in the middle + if (j1 > ny) j1 = int((ny + 1) / 2) + nloop = 1 + else if (x(i) < y(j1)) then + j1 = 1 + else if (x(i) > y(j1)) then + j1 = j1 + 1 + if (j1 > ny) then + j1 = 1 + nloop = nloop + 1 + if (nloop > 2) then + ! stop for infinite loop. This check should not be + ! necessary for halo + call abort_ice(subname // ' ERROR: too many loops') + end if + end if + end if + end do + + end subroutine findXinY_halo + +!======================================================================= + + subroutine numainit(l, u, uu) + + use ice_constants, only : c0 + + implicit none + + integer(kind=int_kind), intent(in) :: l, u, uu + + ! local variables + + integer(kind=int_kind) :: lo, up + + character(len=*), parameter :: subname = '(numainit)' + + call domp_get_domain(l, u, lo, up) + ee(lo:up) = 0 + ne(lo:up) = 0 + se(lo:up) = 0 + sse(lo:up) = 0 + nw(lo:up) = 0 + sw(lo:up) = 0 + halo_parent(lo:up) = 0 + strength(lo:up) = c0 + uvel(lo:up) = c0 + vvel(lo:up) = c0 + uvel_init(lo:up) = c0 + vvel_init(lo:up) = c0 + uocn(lo:up) = c0 + vocn(lo:up) = c0 + dxt(lo:up) = c0 + dyt(lo:up) = c0 + HTE(lo:up) = c0 + HTN(lo:up) = c0 + HTEm1(lo:up) = c0 + HTNm1(lo:up) = c0 + stressp_1(lo:up) = c0 + stressp_2(lo:up) = c0 + stressp_3(lo:up) = c0 + stressp_4(lo:up) = c0 + stressm_1(lo:up) = c0 + stressm_2(lo:up) = c0 + stressm_3(lo:up) = c0 + stressm_4(lo:up) = c0 + stress12_1(lo:up) = c0 + stress12_2(lo:up) = c0 + stress12_3(lo:up) = c0 + stress12_4(lo:up) = c0 + tarear(lo:up) = c0 + Tbu(lo:up) = c0 + taubx(lo:up) = c0 + tauby(lo:up) = c0 + divu(lo:up) = c0 + rdg_conv(lo:up) = c0 + rdg_shear(lo:up) = c0 + shear(lo:up) = c0 + str1(lo:up) = c0 + str2(lo:up) = c0 + str3(lo:up) = c0 + str4(lo:up) = c0 + str5(lo:up) = c0 + str6(lo:up) = c0 + str7(lo:up) = c0 + str8(lo:up) = c0 + + call domp_get_domain(u + 1, uu, lo, up) + halo_parent(lo:up) = 0 + uvel(lo:up) = c0 + vvel(lo:up) = c0 + str1(lo:up) = c0 + str2(lo:up) = c0 + str3(lo:up) = c0 + str4(lo:up) = c0 + str5(lo:up) = c0 + str6(lo:up) = c0 + str7(lo:up) = c0 + str8(lo:up) = c0 + + end subroutine numainit + +!======================================================================= + +end module ice_dyn_evp_1d diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 old mode 100644 new mode 100755 index f59c27f20..bb65f122c --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -40,13 +40,11 @@ module ice_dyn_shared ssh_stress ! 'geostrophic' or 'coupled' logical (kind=log_kind), public :: & - revised_evp ! if true, use revised evp procedure + revised_evp ! if true, use revised evp procedure - integer (kind=int_kind), public :: & - kevp_kernel ! 0 = 2D org version - ! 1 = 1D representation raw (not implemented) - ! 2 = 1D + calculate distances inline (implemented) - ! 3 = 1D + calculate distances inline + real*4 internal (not implemented yet) + character (len=char_len), public :: & + evp_algorithm ! standard_2d = 2D org version (standard) + ! shared_mem_1d = 1d without mpi call and refactorization to 1d ! other EVP parameters character (len=char_len), public :: & @@ -55,12 +53,12 @@ module ice_dyn_shared ! LKD: Lemieux et al. 2015, probabilistic: Dupont et al. in prep. real (kind=dbl_kind), parameter, public :: & - eyc = 0.36_dbl_kind, & - ! coefficient for calculating the parameter E - cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 - sinw = c0 , & ! sin(ocean turning angle) ! turning angle = 0 - a_min = p001, & ! minimum ice area - m_min = p01 ! minimum ice mass (kg/m^2) + eyc = 0.36_dbl_kind, & ! coefficient for calculating the parameter E + u0 = 5e-5_dbl_kind, & ! residual velocity for seabed stress (m/s) + cosw = c1 , & ! cos(ocean turning angle) ! turning angle = 0 + sinw = c0 , & ! sin(ocean turning angle) ! turning angle = 0 + a_min = p001 , & ! minimum ice area + m_min = p01 ! minimum ice mass (kg/m^2) real (kind=dbl_kind), public :: & revp , & ! 0 for classic EVP, 1 for revised EVP @@ -91,12 +89,11 @@ module ice_dyn_shared seabed_stress ! if true, seabed stress for landfast on real (kind=dbl_kind), public :: & - k1, & ! 1st free parameter for seabed1 grounding parameterization - k2, & ! second free parameter (N/m^3) for seabed1 grounding parametrization - alphab, & ! alphab=Cb factor in Lemieux et al 2015 - threshold_hw, & ! max water depth for grounding + k1 , & ! 1st free parameter for seabed1 grounding parameterization + k2 , & ! second free parameter (N/m^3) for seabed1 grounding parametrization + alphab , & ! alphab=Cb factor in Lemieux et al 2015 + threshold_hw ! max water depth for grounding ! see keel data from Amundrud et al. 2004 (JGR) - u0 = 5e-5_dbl_kind ! residual velocity for seabed stress (m/s) !======================================================================= diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index b896c3bb9..c0c089ac8 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -97,9 +97,10 @@ subroutine input_data bathymetry_file, use_bathymetry, & bathymetry_format, & grid_type, grid_format, & - dxrect, dyrect + dxrect, dyrect, & + pgl_global_ext use ice_dyn_shared, only: ndte, kdyn, revised_evp, yield_curve, & - kevp_kernel, & + evp_algorithm, & seabed_stress, seabed_stress_method, & k1, k2, alphab, threshold_hw, & Ktens, e_ratio, coriolis, ssh_stress, & @@ -201,7 +202,7 @@ subroutine input_data namelist /dynamics_nml/ & kdyn, ndte, revised_evp, yield_curve, & - kevp_kernel, & + evp_algorithm, & brlx, arlx, ssh_stress, & advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & @@ -329,7 +330,8 @@ subroutine input_data kdyn = 1 ! type of dynamics (-1, 0 = off, 1 = evp, 2 = eap, 3 = vp) ndtd = 1 ! dynamic time steps per thermodynamic time step ndte = 120 ! subcycles per dynamics timestep: ndte=dt_dyn/dte - kevp_kernel = 0 ! EVP kernel (0 = 2D, >0: 1D. Only ver. 2 is implemented yet) + evp_algorithm = 'standard_2d' ! EVP kernel (=standard_2d: standard cice evp; =shared_mem_1d: 1d shared memory and no mpi. if more mpi processors then executed on master + pgl_global_ext = .false. ! if true, init primary grid lengths (global ext.) brlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared arlx = 300.0_dbl_kind ! revised_evp values. Otherwise overwritten in ice_dyn_shared revised_evp = .false. ! if true, use revised procedure for evp dynamics @@ -669,7 +671,8 @@ subroutine input_data call broadcast_scalar(kdyn, master_task) call broadcast_scalar(ndtd, master_task) call broadcast_scalar(ndte, master_task) - call broadcast_scalar(kevp_kernel, master_task) + call broadcast_scalar(evp_algorithm, master_task) + call broadcast_scalar(pgl_global_ext, master_task) call broadcast_scalar(brlx, master_task) call broadcast_scalar(arlx, master_task) call broadcast_scalar(revised_evp, master_task) @@ -1293,16 +1296,16 @@ subroutine input_data tmpstr2 = ' : revised EVP formulation not used' endif write(nu_diag,1010) ' revised_evp = ', revised_evp,trim(tmpstr2) - - if (kevp_kernel == 0) then - tmpstr2 = ' : original EVP solver' - elseif (kevp_kernel == 2 .or. kevp_kernel == 102) then - tmpstr2 = ' : vectorized EVP solver' + + if (evp_algorithm == 'standard_2d') then + tmpstr2 = ' : standard 2d EVP solver' + elseif (evp_algorithm == 'shared_mem_1d') then + tmpstr2 = ' : vectorized 1d EVP solver' + pgl_global_ext = .true. else tmpstr2 = ' : unknown value' endif - write(nu_diag,1020) ' kevp_kernel = ', kevp_kernel,trim(tmpstr2) - + write(nu_diag,1031) ' evp_algorithm = ', trim(evp_algorithm),trim(tmpstr2) write(nu_diag,1020) ' ndtd = ', ndtd, ' : number of dynamics/advection/ridging/steps per thermo timestep' write(nu_diag,1020) ' ndte = ', ndte, ' : number of EVP or EAP subcycles' endif @@ -1815,19 +1818,11 @@ subroutine input_data abort_list = trim(abort_list)//":20" endif - ! check for valid kevp_kernel - ! tcraig, kevp_kernel=2 is not validated, do not allow use - ! use "102" to test "2" for now - if (kevp_kernel /= 0) then - if (kevp_kernel == 102) then - kevp_kernel = 2 - else - if (my_task == master_task) write(nu_diag,*) subname//' ERROR: kevp_kernel = ',kevp_kernel - if (kevp_kernel == 2) then - if (my_task == master_task) write(nu_diag,*) subname//' kevp_kernel=2 not validated, use kevp_kernel=102 for testing until it is validated' - endif - abort_list = trim(abort_list)//":21" - endif + if (kdyn == 1 .and. & + evp_algorithm /= 'standard_2d' .and. & + evp_algorithm /= 'shared_mem_1d') then + if (my_task == master_task) write(nu_diag,*) subname//' ERROR: unknown evp_algorithm=',trim(evp_algorithm) + abort_list = trim(abort_list)//":21" endif if (abort_list /= "") then diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 635bbbeb4..3959f12cf 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -74,7 +74,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -6807,6 +6808,136 @@ subroutine ice_HaloDestroy(halo) endif end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 index 5f0d0af89..0a58769db 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -1254,7 +1254,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) if (present(spc_val)) then special_value = spc_val else - special_value = .false. !MHRI NOTE: .true./.false. ??? + special_value = .false. endif ARRAY_G = special_value diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 index c66cdd13c..f3fffba59 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 @@ -61,7 +61,8 @@ module ice_boundary ice_HaloUpdate, & ice_HaloUpdate_stress, & ice_HaloExtrapolate, & - ice_HaloDestroy + ice_HaloDestroy, & + primary_grid_lengths_global_ext interface ice_HaloUpdate ! generic interface module procedure ice_HaloUpdate2DR8, & @@ -4587,6 +4588,136 @@ subroutine ice_HaloDestroy(halo) end subroutine ice_HaloDestroy +!*********************************************************************** + + subroutine primary_grid_lengths_global_ext( & + ARRAY_O, ARRAY_I, ew_boundary_type, ns_boundary_type) + +! This subroutine adds ghost cells to global primary grid lengths array +! ARRAY_I and outputs result to array ARRAY_O + +! Note duplicate implementation of this subroutine in: +! cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 + + use ice_constants, only: c0 + use ice_domain_size, only: nx_global, ny_global + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & + ARRAY_I + + character (*), intent(in) :: & + ew_boundary_type, ns_boundary_type + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + ARRAY_O + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (kind=int_kind) :: & + ii, io, ji, jo + + character(len=*), parameter :: & + subname = '(primary_grid_lengths_global_ext)' + +!----------------------------------------------------------------------- +! +! add ghost cells to global primary grid lengths array +! +!----------------------------------------------------------------------- + + if (trim(ns_boundary_type) == 'tripole' .or. & + trim(ns_boundary_type) == 'tripoleT') then + call abort_ice(subname//' ERROR: '//ns_boundary_type & + //' boundary type not implemented for configuration') + endif + + do jo = 1,ny_global+2*nghost + ji = -nghost + jo + + !*** Southern ghost cells + + if (ji < 1) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji + ny_global + case ('open') + ji = nghost - jo + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + !*** Northern ghost cells + + if (ji > ny_global) then + select case (trim(ns_boundary_type)) + case ('cyclic') + ji = ji - ny_global + case ('open') + ji = 2 * ny_global - ji + 1 + case ('closed') + ji = 0 + case default + call abort_ice( & + subname//' ERROR: unknown north-south boundary type') + end select + endif + + do io = 1,nx_global+2*nghost + ii = -nghost + io + + !*** Western ghost cells + + if (ii < 1) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii + nx_global + case ('open') + ii = nghost - io + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + !*** Eastern ghost cells + + if (ii > nx_global) then + select case (trim(ew_boundary_type)) + case ('cyclic') + ii = ii - nx_global + case ('open') + ii = 2 * nx_global - ii + 1 + case ('closed') + ii = 0 + case default + call abort_ice( & + subname//' ERROR: unknown east-west boundary type') + end select + endif + + if (ii == 0 .or. ji == 0) then + ARRAY_O(io, jo) = c0 + else + ARRAY_O(io, jo) = ARRAY_I(ii, ji) + endif + + enddo + enddo + +!----------------------------------------------------------------------- + + end subroutine primary_grid_lengths_global_ext + !*********************************************************************** end module ice_boundary diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 index 515cdfa65..4b0bb1f9e 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_gather_scatter.F90 @@ -687,7 +687,7 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) if (present(spc_val)) then special_value = spc_val else - special_value = .false. !MHRI: true/false + special_value = .false. endif ARRAY_G = special_value diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 9ce22a6f4..18dbaaefe 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -19,7 +19,8 @@ module ice_grid use ice_kinds_mod use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate + use ice_boundary, only: ice_HaloUpdate, ice_HaloExtrapolate, & + primary_grid_lengths_global_ext use ice_communicate, only: my_task, master_task use ice_blocks, only: block, get_block, nx_block, ny_block, nghost use ice_domain_size, only: nx_global, ny_global, max_blocks @@ -77,6 +78,10 @@ module ice_grid ocn_gridcell_frac ! only relevant for lat-lon grids ! gridcell value of [1 - (land fraction)] (T-cell) + real (kind=dbl_kind), dimension (:,:), allocatable, public :: & + G_HTE , & ! length of eastern edge of T-cell (global ext.) + G_HTN ! length of northern edge of T-cell (global ext.) + real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & cyp , & ! 1.5*HTE(i,j)-0.5*HTW(i,j) = 1.5*HTE(i,j)-0.5*HTE(i-1,j) cxp , & ! 1.5*HTN(i,j)-0.5*HTS(i,j) = 1.5*HTN(i,j)-0.5*HTN(i,j-1) @@ -125,7 +130,8 @@ module ice_grid kmt ! ocean topography mask for bathymetry (T-cell) logical (kind=log_kind), public :: & - use_bathymetry ! flag for reading in bathymetry_file + use_bathymetry, & ! flag for reading in bathymetry_file + pgl_global_ext ! flag for init primary grid lengths (global ext.) logical (kind=log_kind), & dimension (:,:,:), allocatable, public :: & @@ -153,6 +159,8 @@ subroutine alloc_grid integer (int_kind) :: ierr + character(len=*), parameter :: subname = '(alloc_grid)' + allocate( & dxt (nx_block,ny_block,max_blocks), & ! width of T-cell through the middle (m) dyt (nx_block,ny_block,max_blocks), & ! height of T-cell through the middle (m) @@ -203,7 +211,15 @@ subroutine alloc_grid mse (2,2,nx_block,ny_block,max_blocks), & msw (2,2,nx_block,ny_block,max_blocks), & stat=ierr) - if (ierr/=0) call abort_ice('(alloc_grid): Out of memory') + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory') + + if (pgl_global_ext) then + allocate( & + G_HTE(nx_global+2*nghost, ny_global+2*nghost), & ! length of eastern edge of T-cell (global ext.) + G_HTN(nx_global+2*nghost, ny_global+2*nghost), & ! length of northern edge of T-cell (global ext.) + stat=ierr) + if (ierr/=0) call abort_ice(subname//'ERROR: Out of memory') + endif end subroutine alloc_grid @@ -1499,6 +1515,10 @@ subroutine primary_grid_lengths_HTN(work_g) enddo enddo endif + if (pgl_global_ext) then + call primary_grid_lengths_global_ext( & + G_HTN, work_g, ew_boundary_type, ns_boundary_type) + endif call scatter_global(HTN, work_g, master_task, distrb_info, & field_loc_Nface, field_type_scalar) call scatter_global(dxu, work_g2, master_task, distrb_info, & @@ -1573,6 +1593,10 @@ subroutine primary_grid_lengths_HTE(work_g) enddo endif endif + if (pgl_global_ext) then + call primary_grid_lengths_global_ext( & + G_HTE, work_g, ew_boundary_type, ns_boundary_type) + endif call scatter_global(HTE, work_g, master_task, distrb_info, & field_loc_Eface, field_type_scalar) call scatter_global(dyu, work_g2, master_task, distrb_info, & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index e918a694c..f9631a91d 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -127,7 +127,7 @@ kdyn = 1 ndte = 240 revised_evp = .false. - kevp_kernel = 0 + evp_algorithm = 'standard_2d' brlx = 300.0 arlx = 300.0 advection = 'remap' diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index 53372f124..98eb311cb 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -17,7 +17,7 @@ sw_frac = 0.9d0 sw_dtemp = 0.02d0 conduct = 'MU71' kdyn = 1 -kevp_kernel = 102 +evp_algorithm = 'shared_mem_1d' fbot_xfer_type = 'Cdn_ocn' shortwave = 'dEdd' formdrag = .true. diff --git a/configuration/scripts/options/set_nml.evp1d b/configuration/scripts/options/set_nml.evp1d new file mode 100644 index 000000000..e7d38e86b --- /dev/null +++ b/configuration/scripts/options/set_nml.evp1d @@ -0,0 +1 @@ +evp_algorithm = 'shared_mem_1d' diff --git a/configuration/scripts/options/set_nml.kevp102 b/configuration/scripts/options/set_nml.kevp102 deleted file mode 100644 index 3a5dc3dbd..000000000 --- a/configuration/scripts/options/set_nml.kevp102 +++ /dev/null @@ -1 +0,0 @@ -kevp_kernel = 102 diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 69252f9fb..78df9ac81 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -9,9 +9,9 @@ smoke gx3 7x2 diag1,bigdiag,run1day,diagpt1 decomp gx3 4x2x25x29x5 none smoke gx3 4x2 diag1,run5day smoke_gx3_8x2_diag1_run5day smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day -restart gx1 40x4 droundrobin -restart tx1 40x4 dsectrobin -restart tx1 60x2 droundrobin,maskhalo +smoke gx3 1x8 diag1,run5day,evp1d smoke_gx3_8x2_diag1_run5day +restart gx1 40x4 droundrobin,medium +restart tx1 40x4 dsectrobin,medium restart gx3 4x4 none restart gx3 10x4 maskhalo restart gx3 6x2 alt01 diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 47b54bde2..48dead1cb 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -6,7 +6,7 @@ Dynamics ============================ -The CICE **cicecore/** directory consists of the non icepack source code. Within that +The CICE **cicecore/** directory consists of the non icepack source code. Within that directory there are the following subdirectories **cicecore/cicedynB/analysis** contains higher level history and diagnostic routines. @@ -30,28 +30,19 @@ Dynamical Solvers -------------------- The dynamics solvers are found in **cicecore/cicedynB/dynamics/**. A couple of different solvers are -available including EVP, revised EVP, EAP and VP. The dynamics solver is specified in namelist with the -``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, ``kdyn=3`` is VP and revised EVP requires -the ``revised_evp`` namelist flag be set to true. - -Multiple EVP solvers are supported thru the namelist flag ``kevp_kernel``. The standard implementation -and current default is ``kevp_kernel=0``. In this case, the stress is solved on the regular decomposition -via subcycling and calls to subroutine ``stress`` and subroutine ``stepu`` with MPI global sums required in each -subcycling call. With ``kevp_kernel=2``, the data required to compute the stress is gathered to the root -MPI process and the stress calculation is performed on the root task without any MPI global sums. OpenMP -parallelism is supported in ``kevp_kernel=2``. The solutions with ``kevp_kernel`` set to 0 or 2 will -not be bit-for-bit -identical but should be the same to roundoff and produce the same climate. ``kevp_kernel=2`` may perform -better for some configurations, some machines, and some pe counts. ``kevp_kernel=2`` is not supported -with the tripole grid and is still being validated. Until ``kevp_kernel=2`` is fully validated, it will -abort if set. To override the abort, use value 102 for testing. +available including EVP, EAP and VP. The dynamics solver is specified in namelist with the +``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, ``kdyn=3`` is VP. + +Two alternative implementations of EVP are included. The first alternative is the Revised EVP, triggered when the ``revised_evp`` is set to true. The second alternative is the 1d EVP solver triggered when the ``evp_algorithm`` is set to ``shared_mem_1d`` as oppose to the default setting of ``evp_standard_2d``. The solutions with ``evp_algorithm`` set to ``standard_2d`` or ``shared_mem_1d`` will +not be bit-for-bit identical when compared to each other. The reason for this is floating point round off errors that occur unless strict compiler flags are used. ``evp_algorithm=shared_mem_1d`` is primarily built for OpenMP. If MPI domain splitting is used then the solver will only run on the master processor. ``evp_algorithm=shared_mem_1d`` is not supported +with the tripole grid. Transport ----------------- -The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Two methods are supported, -upwind and remap. These are set in namelist via the ``advection`` variable. +The transport (advection) methods are found in **cicecore/cicedynB/dynamics/**. Two methods are supported, +upwind and remap. These are set in namelist via the ``advection`` variable. Transport can be disabled with the ``ktransport`` namelist variable. @@ -90,7 +81,7 @@ Time Manager Time manager data is module data in **cicecore/shared/ice_calendar.F90**. Much of the time manager data is public and operated on during the model timestepping. The model timestepping actually takes -place in the **CICE_RunMod.F90** file which is part of the driver code. +place in the **CICE_RunMod.F90** file which is part of the driver code. The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus` @@ -100,12 +91,12 @@ Communication ------------------ Two low-level communications packages, mpi and serial, are provided as part of CICE. This software -provides a middle layer between the model and the underlying libraries. Only the CICE mpi or +provides a middle layer between the model and the underlying libraries. Only the CICE mpi or serial directories are compiled with CICE, not both. -**cicedynB/infrastructure/comm/mpi/** +**cicedynB/infrastructure/comm/mpi/** is based on MPI and provides various methods to do halo updates, global sums, gather/scatter, broadcasts -and similar using some fairly generic interfaces to isolate the MPI calls in the code. +and similar using some fairly generic interfaces to isolate the MPI calls in the code. **cicedynB/infrastructure/comm/serial/** support the same interfaces, but operates in shared memory mode with no MPI. The serial library will be used, by default in the CICE scripts, @@ -124,7 +115,7 @@ case. This has to be set before CICE is built. **cicedynB/infrastructure/io/io_netcdf/** is the default for the standalone CICE model, and it supports writing history and restart files in netcdf format using standard netcdf calls. It does this by writing from and reading to the root task and -gathering and scattering fields from the root task to support model parallelism. +gathering and scattering fields from the root task to support model parallelism. **cicedynB/infrastructure/io/io_binary/** supports files in binary format using a gather/scatter approach and reading to and writing from the root task. @@ -134,4 +125,3 @@ is a parallel io library (https://github.com/NCAR/ParallelIO) that supports read binary and netcdf file through various interfaces including netcdf and pnetcdf. pio is generally more parallel in memory even when using serial netcdf than the standard gather/scatter methods, and it provides parallel read/write capabilities by optionally linking and using pnetcdf. - diff --git a/doc/source/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index 0c0380538..aea6d8ef6 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -180,7 +180,7 @@ constant thereafter. Different conditions can be specified thru the .. _box2001forcing: Box2001 Atmosphere Forcing -------------------------- +--------------------------- The box2001 forcing dataset in generated internally. No files are read. The dataset is used to test an idealized box case as defined in :cite:`Hunke01`. diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index ecef531b4..d4e209d8a 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -6,10 +6,9 @@ Dynamics ======== There are different approaches in the CICE code for representing sea ice -rheology and for solving the sea ice momentum equation. The -elastic-viscous-plastic (EVP) model represents a modification of the -standard viscous-plastic (VP) model for sea ice dynamics -:cite:`Hibler79`. The elastic-anisotropic-plastic (EAP) model, +rheology and for solving the sea ice momentum equation. The viscous-plastic (VP) originally developed by :cite:`Hibler79`, +the elastic-viscous-plastic (EVP) :cite:`Hunke97` model represents a modification of the +standard viscous-plastic (VP) model for sea ice dynamics. The elastic-anisotropic-plastic (EAP) model, on the other hand, explicitly accounts for the observed sub-continuum anisotropy of the sea ice cover :cite:`Wilchinsky06,Weiss09`. If ``kdyn`` = 1 in the namelist then the EVP model is used (module @@ -68,7 +67,7 @@ vertical direction: where :math:`m` is the combined mass of ice and snow per unit area and :math:`\vec{\tau}_a` and :math:`\vec{\tau}_w` are wind and ocean -stresses, respectively. The term :math:`\vec{\tau}_b` is a +stresses, respectively. The term :math:`\vec{\tau}_b` is a seabed stress (also referred to as basal stress) that represents the grounding of pressure ridges in shallow water :cite:`Lemieux16`. The mechanical properties of the ice are represented by the internal stress tensor :math:`\sigma_{ij}`. The other two terms on @@ -84,11 +83,11 @@ For clarity, the two components of Equation :eq:`vpmom` are .. math:: \begin{aligned} - m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + + m{\partial u\over\partial t} &= {\partial\sigma_{1j}\over\partial x_j} + \tau_{ax} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\cos\theta - \left(V_w-v\right)\sin\theta\right] -C_bu +mfv - mg{\partial H_\circ\over\partial x}, \\ - m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + + m{\partial v\over\partial t} &= {\partial\sigma_{2j}\over\partial x_j} + \tau_{ay} + a_i c_w \rho_w \left|{\bf U}_w - {\bf u}\right| \left[\left(U_w-u\right)\sin\theta + \left(V_w-v\right)\cos\theta\right] -C_bv-mfu - mg{\partial H_\circ\over\partial y}. \end{aligned} @@ -111,14 +110,14 @@ Elastic-Viscous-Plastic The momentum equation is discretized in time as follows, for the classic EVP approach. In the code, -:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and -:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, +:math:`{\tt vrel}=a_i c_w \rho_w\left|{\bf U}_w - {\bf u}^k\right|` and +:math:`C_b=T_b \left( \sqrt{(u^k)^2+(v^k)^2}+u_0 \right)^{-1}`, where :math:`k` denotes the subcycling step. The following equations illustrate the time discretization and define some of the other variables used in the code. .. math:: - \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} = &\underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} \\ @@ -126,7 +125,7 @@ variables used in the code. :label: umom .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left({m\over\Delta t_e}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} = &\underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} \\ @@ -139,7 +138,7 @@ We solve this system of equations analytically for :math:`u^{k+1}` and :math:`v^{k+1}`. Define .. math:: - \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k + \hat{u} = F_u + \tau_{ax} - mg{\partial H_\circ\over\partial x} + {\tt vrel} \left(U_w\cos\theta - V_w\sin\theta\right) + {m\over\Delta t_e}u^k :label: cevpuhat .. math:: @@ -169,7 +168,7 @@ where .. math:: b = mf + {\tt vrel}\sin\theta. :label: cevpb - + .. _vp-momentum: Viscous-Plastic @@ -248,52 +247,52 @@ stress are expressed as :math:`\tau_{bx}=C_bu` and coefficient. The two parameterizations differ in their calculation of -the :math:`C_b` coefficients. +the :math:`C_b` coefficients. Note that the user must provide a bathymetry field for using these grounding schemes. It is suggested to have a bathymetry field with water depths larger than 5 m that represents well shallow water (less than 30 m) regions such as the Laptev Sea -and the East Siberian Sea. +and the East Siberian Sea. Seabed stress based on linear keel draft (LKD) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This parameterization for the seabed stress is described in :cite:`Lemieux16`. It assumes that the largest keel draft varies linearly with the mean thickness in a grid cell (i.e. sea ice volume). The :math:`C_b` coefficients are expressed as .. math:: C_b= k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)} (\sqrt{u^2+v^2}+u_0)^{-1}, \\ - :label: Cb + :label: Cb -where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` -is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when -the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)}` is defined as -:math:`T_b`. The quantities :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}` are calculated at -the 'u' point based on local ice conditions (surrounding tracer points). They are respectively given by +where :math:`k_2` determines the maximum seabed stress that can be sustained by the grounded parameterized ridge(s), :math:`u_0` +is a small residual velocity and :math:`\alpha_b` is a parameter to ensure that the seabed stress quickly drops when +the ice concentration is smaller than 1. In the code, :math:`k_2 \max [0,(h_u - h_{cu})] e^{-\alpha_b * (1 - a_u)}` is defined as +:math:`T_b`. The quantities :math:`h_u`, :math:`a_{u}` and :math:`h_{cu}` are calculated at +the 'u' point based on local ice conditions (surrounding tracer points). They are respectively given by .. math:: h_u=\max[v_i(i,j),v_i(i+1,j),v_i(i,j+1),v_i(i+1,j+1)], \\ - :label: hu - + :label: hu + .. math:: a_u=\max[a_i(i,j),a_i(i+1,j),a_i(i,j+1),a_i(i+1,j+1)]. \\ - :label: au - + :label: au + .. math:: h_{cu}=a_u h_{wu} / k_1, \\ :label: hcu -where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the :math:`u` point :math:`i,j` and -:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized -ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only -when :math:`h_u > h_{cu}`. +where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice volumes around the :math:`u` point :math:`i,j` and +:math:`k_1` is a parameter that defines the critical ice thickness :math:`h_{cu}` at which the parameterized +ridge(s) reaches the seafloor for a water depth :math:`h_{wu}=\min[h_w(i,j),h_w(i+1,j),h_w(i,j+1),h_w(i+1,j+1)]`. Given the formulation of :math:`C_b` in equation :eq:`Cb`, the seabed stress components are non-zero only +when :math:`h_u > h_{cu}`. -The maximum seabed stress depends on the weight of the ridge -above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. -The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. +The maximum seabed stress depends on the weight of the ridge +above hydrostatic balance and the value of :math:`k_2`. It is, however, the parameter :math:`k_1` that has the most notable impact on the simulated extent of landfast ice. +The value of :math:`k_1` can be changed at runtime using the namelist variable ``k1``. -To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` -is larger than 30 m. This maximum value is chosen based on observations of large +To prevent unrealistic grounding, :math:`T_b` is set to zero when :math:`h_{wu}` +is larger than 30 m. This maximum value is chosen based on observations of large keels in the Arctic Ocean :cite:`Amundrud04`. Seabed stress based on probabilistic approach @@ -304,11 +303,11 @@ on the probability of contact between the ice thickness distribution (ITD) and the seabed. Multi-thickness category models such as CICE typically use a few thickness categories (5-10). This crude representation of the ITD does not resolve the tail of the ITD, which is crucial for grounding -events. +events. To represent the tail of the distribution, the simulated ITD is converted to a positively skewed probability function :math:`f(x)` -with :math:`x` the sea ice thickness. The mean and variance are set +with :math:`x` the sea ice thickness. The mean and variance are set equal to the ones of the original ITD. A log-normal distribution is used for :math:`f(x)`. @@ -317,7 +316,7 @@ distribution :math:`b(y)`. The mean of :math:`b(y)` comes from the user's bathym standard deviation :math:`\sigma_b` is currently fixed to 2.5 m. Two possible improvements would be to specify a distribution based on high resolution bathymetry data and to take into account variations of the -water depth due to changes in the sea surface height. +water depth due to changes in the sea surface height. Assuming hydrostatic balance and neglecting the impact of snow, the draft of floating ice of thickness :math:`x` is :math:`D(x)=\rho_i x / \rho_w` where :math:`\rho_i` is the sea ice density. Hence, the probability of contact (:math:`P_c`) between the @@ -337,7 +336,7 @@ and then obtains :math:`T_{bt}` by multiplying :math:`T_{bt}^*` by :math:`e^{-\a To calculate :math:`T_{bt}^*` in equation :eq:`Tbt`, :math:`f(x)` and :math:`b(y)` are discretized using many small categories (100). :math:`f(x)` is discretized between 0 and 50 m while :math:`b(y)` is truncated at plus and minus three :math:`\sigma_b`. :math:`f(x)` is also modified by setting it to zero after a certain percentile of the log-normal distribution. This percentile, which is currently set to 99.7%, notably affects the simulation of landfast ice and is used as a tuning parameter. Its impact is similar to the one of the parameter :math:`k_1` for the LKD method. -:math:`T_b` at the 'u' point is calculated from the 't' point values around it according to +:math:`T_b` at the 'u' point is calculated from the 't' point values around it according to .. math:: T_b=\max[T_{bt}(i,j),T_{bt}(i+1,j),T_{bt}(i,j+1),T_{bt}(i+1,j+1)]. \\ @@ -362,13 +361,13 @@ divergence, :math:`D_D`, and the horizontal tension and shearing strain rates, :math:`D_T` and :math:`D_S` respectively: .. math:: - D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, + D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, .. math:: - D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, + D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, .. math:: - D_S = 2\dot{\epsilon}_{12}, + D_S = 2\dot{\epsilon}_{12}, where @@ -376,12 +375,12 @@ where \dot{\epsilon}_{ij} = {1\over 2}\left({{\partial u_i}\over{\partial x_j}} + {{\partial u_j}\over{\partial x_i}}\right) CICE can output the internal ice pressure which is an important field to support navigation in ice-infested water. -The internal ice pressure (``sigP``) is the average of the normal stresses multiplied by :math:`-1` and +The internal ice pressure (``sigP``) is the average of the normal stresses multiplied by :math:`-1` and is therefore simply equal to :math:`-\sigma_1/2`. -Following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the -elliptical yield curve can be modified such that the ice has isotropic tensile strength. -The tensile strength :math:`T_p` is expressed as a fraction of the ice strength :math:`P`, that is :math:`T_p=k_t P` +Following the approach of :cite:`Konig10` (see also :cite:`Lemieux16`), the +elliptical yield curve can be modified such that the ice has isotropic tensile strength. +The tensile strength :math:`T_p` is expressed as a fraction of the ice strength :math:`P`, that is :math:`T_p=k_t P` where :math:`k_t` should be set to a value between 0 and 1 (this can be changed at runtime with the namelist parameter ``Ktens``). The ice strength :math:`P` is a function of the ice thickness distribution as @@ -403,10 +402,10 @@ where :math:`\eta` and :math:`\zeta` are the bulk and shear viscosities. An elliptical yield curve is used, with the viscosities given by .. math:: - \zeta = {P(1+k_t)\over 2\Delta}, + \zeta = {P(1+k_t)\over 2\Delta}, .. math:: - \eta = {P(1+k_t)\over {2\Delta e^2}}, + \eta = {P(1+k_t)\over {2\Delta e^2}}, where @@ -447,7 +446,7 @@ dynamics component is subcycled within the time step, and the elastic parameter :math:`E` is defined in terms of a damping timescale :math:`T` for elastic waves, :math:`\Delta t_e < T < \Delta t`, as -.. math:: +.. math:: E = {\zeta\over T}, where :math:`T=E_\circ\Delta t` and :math:`E_\circ` (eyc) is a tunable @@ -455,7 +454,7 @@ parameter less than one. Including the modification proposed by :cite:`Bouillon1 .. math:: \begin{aligned} - {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} + {\partial\sigma_1\over\partial t} + {\sigma_1\over 2T} + {P_R(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta} D_D, \\ {\partial\sigma_2\over\partial t} + {\sigma_2\over 2T} &=& {P(1+k_t)\over 2Te^2\Delta} D_T,\\ @@ -466,14 +465,14 @@ Once discretized in time, these last three equations are written as .. math:: \begin{aligned} - {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} + {(\sigma_1^{k+1}-\sigma_1^{k})\over\Delta t_e} + {\sigma_1^{k+1}\over 2T} + {P_R^k(1-k_t)\over 2T} &=& {P(1+k_t)\over 2T\Delta^k} D_D^k, \\ {(\sigma_2^{k+1}-\sigma_2^{k})\over\Delta t_e} + {\sigma_2^{k+1}\over 2T} &=& {P(1+k_t)\over 2Te^2\Delta^k} D_T^k,\\ {(\sigma_{12}^{k+1}-\sigma_{12}^{k})\over\Delta t_e} + {\sigma_{12}^{k+1}\over 2T} &=& {P(1+k_t)\over 4Te^2\Delta^k}D_S^k,\end{aligned} - :label: sigdisc - + :label: sigdisc + where :math:`k` denotes again the subcycling step. All coefficients on the left-hand side are constant except for :math:`P_R`. This modification compensates for the decreased efficiency of including @@ -498,7 +497,7 @@ anisotropy of the sea ice cover is accounted for by an additional prognostic variable, the structure tensor :math:`\mathbf{A}` defined by -.. math:: +.. math:: {\mathbf A}=\int_{\mathbb{S}}\vartheta(\mathbf r)\mathbf r\mathbf r d\mathbf r\label{structuretensor}. where :math:`\mathbb{S}` is a unit-radius circle; **A** is a unit @@ -517,7 +516,7 @@ components of :math:`\mathbf{A}`, :math:`A_{1}/A_{2}`, are derived from the phenomenological evolution equation for the structure tensor :math:`\mathbf A`, -.. math:: +.. math:: \frac{D\mathbf{A}}{D t}=\mathbf{F}_{iso}(\mathbf{A})+\mathbf{F}_{frac}(\mathbf{A},\boldsymbol\sigma), :label: evolutionA @@ -581,7 +580,7 @@ of two equations: .. math:: \begin{aligned} - \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ + \frac{\partial A_{11}}{\partial t}&=&-k_{t}\left(A_{11}-\frac{1}{2}\right)+M_{11} \mbox{,} \\ \frac{\partial A_{12}}{\partial t}&=&-k_{t} A_{12}+M_{12} \mbox{,}\end{aligned} where the first terms on the right hand side correspond to the @@ -618,7 +617,7 @@ but in a continuum-scale sea ice region the floes can possess different orientations in different places and we take the mean sea ice stress over a collection of floes to be given by the average -.. math:: +.. math:: \boldsymbol\sigma^{EAP}(h)=P_{r}(h)\int_{\mathbb{S}}\vartheta(\mathbf r)\left[\boldsymbol\sigma_{r}^{b}(\mathbf r)+ k \boldsymbol\sigma_{s}^{b}(\mathbf r)\right]d\mathbf r :label: stressaverage @@ -633,11 +632,11 @@ efficient, explicit numerical algorithm used to solve the full sea ice momentum balance. We use the analogous EAP stress equations, .. math:: - \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} + \frac{\partial \sigma_{1}}{\partial t}+\frac{\sigma_1}{2T} = \frac{\sigma^{EAP}_{1}}{2T} \mbox{,} :label: EAPsigma1 .. math:: - \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} + \frac{\partial \sigma_{2}}{\partial t}+\frac{\sigma_2}{2T} = \frac{\sigma^{EAP}_{2}}{2T} \mbox{,} :label: EAPsigma2 .. math:: @@ -676,44 +675,44 @@ of the dynamics. Revised approach **************** -The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution -(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of -implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become +The revised EVP approach is based on a pseudo-time iterative scheme :cite:`Lemieux12`, :cite:`Bouillon13`, :cite:`Kimmritz15`. By construction, the revised EVP approach should lead to the VP solution +(given the right numerical parameters and a sufficiently large number of iterations). To do so, the inertial term is formulated such that it matches the backward Euler approach of +implicit solvers and there is an additional term for the pseudo-time iteration. Hence, with the revised approach, the discretized momentum equations :eq:`umom` and :eq:`vmom` become .. math:: - {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} + {\beta^*(u^{k+1}-u^k)\over\Delta t_e} + {m(u^{k+1}-u^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)} u^{k+1} - {\left(mf+{\tt vrel}\sin\theta\right)} v^{k+1} - = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + = {{\partial\sigma_{1j}^{k+1}\over\partial x_j}} + {\tau_{ax} - mg{\partial H_\circ\over\partial x} } + {\tt vrel} {\left(U_w\cos\theta-V_w\sin\theta\right)}, :label: umomr .. math:: - {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} - + {\left(mf+{\tt vrel}\sin\theta\right)} u^{k+1} - = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + {\beta^*(v^{k+1}-v^k)\over\Delta t_e} + {m(v^{k+1}-v^n)\over\Delta t} + {\left({\tt vrel} \cos\theta + C_b \right)}v^{k+1} + + {\left(mf+{\tt vrel}\sin\theta\right)} u^{k+1} + = {{\partial\sigma_{2j}^{k+1}\over\partial x_j}} + {\tau_{ay} - mg{\partial H_\circ\over\partial y} } + {\tt vrel}{\left(U_w\sin\theta+V_w\cos\theta\right)}, :label: vmomr -where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. +where :math:`\beta^*` is a numerical parameter and :math:`u^n, v^n` are the components of the previous time level solution. With :math:`\beta=\beta^* \Delta t \left( m \Delta t_e \right)^{-1}` :cite:`Bouillon13`, these equations can be written as - + .. math:: - \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta\ + C_b \right)}_{\tt cca} u^{k+1} - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb}v^{k+1} - = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + = \underbrace{{\partial\sigma_{1j}^{k+1}\over\partial x_j}}_{\tt strintx} + \underbrace{\tau_{ax} - mg{\partial H_\circ\over\partial x} }_{\tt forcex} + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t}(\beta u^k + u^n), :label: umomr2 .. math:: - \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left(mf+{\tt vrel}\sin\theta\right)}_{\tt ccb} u^{k+1} + \underbrace{\left((\beta+1){m\over\Delta t}+{\tt vrel} \cos\theta + C_b \right)}_{\tt cca}v^{k+1} - = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + = \underbrace{{\partial\sigma_{2j}^{k+1}\over\partial x_j}}_{\tt strinty} + \underbrace{\tau_{ay} - mg{\partial H_\circ\over\partial y} }_{\tt forcey} + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t}(\beta v^k + v^n), - :label: vmomr2 + :label: vmomr2 At this point, the solutions :math:`u^{k+1}` and :math:`v^{k+1}` are obtained in the same manner as for the standard EVP approach (see equations :eq:`cevpuhat` to :eq:`cevpb`). @@ -721,16 +720,26 @@ Introducing another numerical parameter :math:`\alpha=2T \Delta t_e ^{-1}` :cite .. math:: \begin{aligned} - {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} + {\alpha (\sigma_1^{k+1}-\sigma_1^{k})} + {\sigma_1^{k}} + {P_R^k(1-k_t)} &=& {P(1+k_t)\over \Delta^k} D_D^k, \\ {\alpha (\sigma_2^{k+1}-\sigma_2^{k})} + {\sigma_2^{k}} &=& {P(1+k_t)\over e^2\Delta^k} D_T^k,\\ {\alpha (\sigma_{12}^{k+1}-\sigma_{12}^{k})} + {\sigma_{12}^{k}} &=& {P(1+k_t)\over 2e^2\Delta^k}D_S^k,\end{aligned} - -where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, as opposed to the classic EVP, -:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. -Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. -The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. -In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx``. The values of ``arlx`` and ``brlx`` can be set in the namelist. + +where as opposed to the classic EVP, the second term in each equation is at iteration :math:`k` :cite:`Bouillon13`. Also, as opposed to the classic EVP, +:math:`\Delta t_e` times the number of subcycles (or iterations) does not need to be equal to the advective time step :math:`\Delta t`. +Finally, as with the classic EVP approach, the stresses are initialized using the previous time level values. +The revised EVP is activated by setting the namelist parameter ``revised_evp = true``. +In the code :math:`\alpha` is ``arlx`` and :math:`\beta` is ``brlx``. The values of ``arlx`` and ``brlx`` can be set in the namelist. It is recommended to use large values of these parameters and to set :math:`\alpha=\beta` :cite:`Kimmritz15`. + +.. _evp1d: + +**************** +1d EVP solver +**************** + +The standard EVP solver iterates hundreds of times, where each iteration includes a communication through MPI and a limited number of calculations. This limits how much the solver can be optimized as the speed is primarily determined by the communication. The 1d EVP solver avoids the communication by utilizing shared memory, which removes the requirement for calls to the MPI communicator. As a consequence of this the potential scalability of the code is improved. The performance is best on shared memory but the solver is also functional on MPI and hybrid MPI/OpenMP setups as it will run on the master processor alone. + +The scalability of geophysical models is in general terms limited by the memory usage. In order to optimize this the 1d EVP solver solves the same equations that are outlined in the section :ref:`stress-evp` but it transforms all matrices to vectors (1d matrices) as this compiles better with the computer hardware. The vectorization and the contiguous placement of arrays in the memory makes it easier for the compiler to optimize the code and pass pointers instead of copying the vectors. The 1d solver is not supported for tripole grids and the code will abort if this combination is attempted. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 562a5bc81..b1f6b4614 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -395,8 +395,8 @@ dynamics_nml "", "``1``", "EVP dynamics", "" "", "``2``", "EAP dynamics", "" "", "``3``", "VP dynamics", "" - "``kevp_kernel``", "``0``", "standard 2D EVP memory parallel solver", "0" - "", "``2``", "1D shared memory solver (not fully validated)", "" + "``evp_algorithm``", "``standard_2d``", "standard 2d EVP memory parallel solver", "standard_2d" + "", "``shared_mem_1d``", "1d shared memory solver", "" "``kstrength``", "``0``", "ice strength formulation :cite:`Hibler79`", "1" "", "``1``", "ice strength formulation :cite:`Rothrock75`", "" "``krdg_partic``", "``0``", "old ridging participation function", "1" From 441f69396b5cc91935cf86019b8700b38f9547fc Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 10 Aug 2021 17:04:56 -0600 Subject: [PATCH 06/15] Fix history features - Fix bug in history time axis when sec_init is not zero. - Fix issue with time_beg and time_end uninitialized values. - Add support for averaging with histfreq='1' by allowing histfreq_n to be any value in that case. Extend and clean up construct_filename for history files. More could be done, but wanted to preserve backwards compatibility. - Add new calendar_sec2hms to converts daily seconds to hh:mm:ss. Update the calchk calendar unit tester to check this method - Remove abort test in bcstchk, this was just causing problems in regression testing - Remove known problems documentation about problems writing when istep=1. This issue does not exist anymore with the updated time manager. - Add new tests with hist_avg = false. Add set_nml.histinst. --- cicecore/cicedynB/analysis/ice_history.F90 | 16 +-- .../cicedynB/analysis/ice_history_shared.F90 | 97 ++++++++++--------- .../io/io_netcdf/ice_history_write.F90 | 30 +++--- .../io/io_pio2/ice_history_write.F90 | 71 ++++++++------ cicecore/drivers/unittest/bcstchk/bcstchk.F90 | 25 +---- cicecore/drivers/unittest/calchk/calchk.F90 | 30 +++++- cicecore/shared/ice_calendar.F90 | 33 ++++++- configuration/scripts/options/set_nml.histall | 2 +- .../scripts/options/set_nml.histinst | 1 + configuration/scripts/tests/io_suite.ts | 6 ++ doc/source/user_guide/ug_troubleshooting.rst | 3 - 11 files changed, 182 insertions(+), 132 deletions(-) create mode 100644 configuration/scripts/options/set_nml.histinst diff --git a/cicecore/cicedynB/analysis/ice_history.F90 b/cicecore/cicedynB/analysis/ice_history.F90 index f91562449..c50ec7b9f 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -1758,6 +1758,7 @@ subroutine accum_hist (dt) nstrm ! nstreams (1 if writing initial condition) real (kind=dbl_kind) :: & + timedbl , & ! temporary dbl for time bounds ravgct , & ! 1/avgct ravgctz ! 1/avgct @@ -1814,7 +1815,7 @@ subroutine accum_hist (dt) n4Dfcum = n4Dscum + num_avail_hist_fields_4Df ! should equal num_avail_hist_fields_tot do ns = 1,nstreams - if (.not. hist_avg .or. histfreq(ns) == '1') then ! write snapshots + if (.not. hist_avg) then ! write snapshots do n = 1,n2D if (avail_hist_fields(n)%vhistfreq == histfreq(ns)) & a2D(:,:,n,:) = c0 @@ -1862,11 +1863,10 @@ subroutine accum_hist (dt) avgct(ns) = c1 else ! write averages over time histfreq avgct(ns) = avgct(ns) + c1 -! if (avgct(ns) == c1) time_beg(ns) = (time-dt)/int(secday) - if (avgct(ns) == c1) then - time_beg(ns) = (timesecs-dt)/int(secday) - time_beg(ns) = real(time_beg(ns),kind=real_kind) - endif + endif + if (avgct(ns) == c1) then + timedbl = (timesecs-dt)/(secday) + time_beg(ns) = real(timedbl,kind=real_kind) endif enddo @@ -3966,8 +3966,8 @@ subroutine accum_hist (dt) enddo ! iblk !$OMP END PARALLEL DO - time_end(ns) = timesecs/int(secday) - time_end(ns) = real(time_end(ns),kind=real_kind) + timedbl = timesecs/secday + time_end(ns) = real(timedbl,kind=real_kind) !--------------------------------------------------------------- ! write file diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index 52d268990..f0343f320 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -672,64 +672,67 @@ subroutine construct_filename(ncfile,suffix,ns) iday = mday isec = msec - dt - if (write_ic) isec = msec ! construct filename if (write_ic) then + isec = msec write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & incond_file(1:lenstr(incond_file)),'.',iyear,'-', & - imonth,'-',iday,'-',isec,'.',suffix + imonth,'-',iday,'-',isec,'.',trim(suffix) else - if (hist_avg .and. histfreq(ns) /= '1') then - if (histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then - ! do nothing - elseif (new_year) then - iyear = iyear - 1 - imonth = 12 - iday = daymo(imonth) - elseif (new_month) then - imonth = mmonth - 1 - iday = daymo(imonth) - elseif (new_day) then - iday = iday - 1 - endif - endif - - cstream = '' + if (hist_avg) then + if (histfreq(ns) == '1' .or. histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then + ! do nothing + elseif (new_year) then + iyear = iyear - 1 + imonth = 12 + iday = daymo(imonth) + elseif (new_month) then + imonth = mmonth - 1 + iday = daymo(imonth) + elseif (new_day) then + iday = iday - 1 + endif + endif + + cstream = '' !echmod ! this was implemented for CESM but it breaks post-processing software !echmod ! of other groups (including RASM which uses CESMCOUPLED) !echmod if (ns > 1) write(cstream,'(i1.1)') ns-1 - if (histfreq(ns) == '1') then ! instantaneous, write every dt - write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & - history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & - iyear,'-',imonth,'-',iday,'-',msec,'.',suffix - - elseif (hist_avg) then ! write averaged data - - if (histfreq(ns) == 'd'.or.histfreq(ns) == 'D') then ! daily - write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,a)') & - history_file(1:lenstr(history_file))//trim(cstream), & - '.',iyear,'-',imonth,'-',iday,'.',suffix - elseif (histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then ! hourly - write(ncfile,'(a,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & - history_file(1:lenstr(history_file))//trim(cstream),'_', & - histfreq_n(ns),'h.',iyear,'-',imonth,'-',iday,'-',msec,'.',suffix - elseif (histfreq(ns) == 'm'.or.histfreq(ns) == 'M') then ! monthly - write(ncfile,'(a,a,i4.4,a,i2.2,a,a)') & - history_file(1:lenstr(history_file))//trim(cstream),'.', & - iyear,'-',imonth,'.',suffix - elseif (histfreq(ns) == 'y'.or.histfreq(ns) == 'Y') then ! yearly - write(ncfile,'(a,a,i4.4,a,a)') & - history_file(1:lenstr(history_file))//trim(cstream),'.', & - iyear,'.',suffix - endif + if (hist_avg) then ! write averaged data + if (histfreq(ns) == '1' .and. histfreq_n(ns) == 1) then ! timestep + write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & + iyear,'-',imonth,'-',iday,'-',msec,'.',trim(suffix) + elseif (histfreq(ns) == '1' .and. histfreq_n(ns) > 1) then ! timestep + write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'.', & + iyear,'-',imonth,'-',iday,'-',msec,'.',trim(suffix) + elseif (histfreq(ns) == 'h'.or.histfreq(ns) == 'H') then ! hourly + write(ncfile,'(a,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'_', & + histfreq_n(ns),'h.',iyear,'-',imonth,'-',iday,'-',msec,'.',trim(suffix) + elseif (histfreq(ns) == 'd'.or.histfreq(ns) == 'D') then ! daily + write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'.', & + iyear,'-',imonth,'-',iday,'.',trim(suffix) + elseif (histfreq(ns) == 'm'.or.histfreq(ns) == 'M') then ! monthly + write(ncfile,'(a,a,i4.4,a,i2.2,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'.', & + iyear,'-',imonth,'.',trim(suffix) + elseif (histfreq(ns) == 'y'.or.histfreq(ns) == 'Y') then ! yearly + write(ncfile,'(a,a,i4.4,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'.', & + iyear,'.',trim(suffix) + endif + + else ! instantaneous + write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & + history_file(1:lenstr(history_file))//trim(cstream),'_inst.', & + iyear,'-',imonth,'-',iday,'-',msec,'.',trim(suffix) + endif - else ! instantaneous with histfreq > dt - write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & - history_file(1:lenstr(history_file)),'_inst.', & - iyear,'-',imonth,'-',iday,'-',msec,'.',suffix - endif endif end subroutine construct_filename diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index 9c6b30ee1..9fe3a5bfe 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -48,8 +48,8 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & - histfreq, days_per_year, use_leap_years, dayyr, & - year_init, month_init, day_init + histfreq, histfreq_n, days_per_year, use_leap_years, dayyr, & + hh_init, mm_init, ss_init use ice_communicate, only: my_task, master_task use ice_domain, only: distrb_info use ice_domain_size, only: nx_global, ny_global, max_nstrm, max_blocks @@ -205,7 +205,6 @@ subroutine ice_write_hist (ns) ! define coordinate variables !----------------------------------------------------------------- -!sgl status = nf90_def_var(ncid,'time',nf90_float,timid,varid) status = nf90_def_var(ncid,'time',nf90_double,timid,varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining var time') @@ -215,8 +214,9 @@ subroutine ice_write_hist (ns) 'ice Error: time long_name') write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init status = nf90_put_att(ncid,varid,'units',title) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time units') @@ -258,8 +258,9 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time_bounds long_name') write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init status = nf90_put_att(ncid,varid,'units',title) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: time_bounds units') @@ -575,7 +576,8 @@ subroutine ice_write_hist (ns) endif endif - if (histfreq(ns) == '1' .or. .not. hist_avg & + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg & .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots .or. n==n_sig1(ns) .or. n==n_sig2(ns) & .or. n==n_sigP(ns) .or. n==n_trsig(ns) & @@ -640,7 +642,8 @@ subroutine ice_write_hist (ns) 'ERROR: defining cell methods for '//avail_hist_fields(n)%vname) endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = nf90_put_att(ncid,varid,'time_rep','instantaneous') else status = nf90_put_att(ncid,varid,'time_rep','averaged') @@ -881,7 +884,8 @@ subroutine ice_write_hist (ns) 'ERROR: defining cell methods for '//avail_hist_fields(n)%vname) endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = nf90_put_att(ncid,varid,'time_rep','instantaneous') else status = nf90_put_att(ncid,varid,'time_rep','averaged') @@ -942,7 +946,8 @@ subroutine ice_write_hist (ns) 'ERROR: defining cell methods for '//avail_hist_fields(n)%vname) endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = nf90_put_att(ncid,varid,'time_rep','instantaneous') else status = nf90_put_att(ncid,varid,'time_rep','averaged') @@ -1003,7 +1008,8 @@ subroutine ice_write_hist (ns) 'ERROR: defining cell methods for '//avail_hist_fields(n)%vname) endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = nf90_put_att(ncid,varid,'time_rep','instantaneous') else status = nf90_put_att(ncid,varid,'time_rep','averaged') diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index 72a1ed97f..b35b44b1b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -42,7 +42,8 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & - histfreq, days_per_year, use_leap_years, dayyr + histfreq, histfreq_n, days_per_year, use_leap_years, dayyr, & + hh_init, mm_init, ss_init use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c360, spval, spval_dbl use ice_domain, only: distrb_info, nblocks @@ -70,7 +71,6 @@ subroutine ice_write_hist (ns) integer (kind=int_kind), dimension(5) :: dimidcz integer (kind=int_kind), dimension(3) :: dimid_nverts integer (kind=int_kind), dimension(6) :: dimidex - real (kind=real_kind) :: ltime real (kind= dbl_kind) :: ltime2 character (char_len) :: title character (char_len_long) :: ncfile(max_nstrm) @@ -176,7 +176,6 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) ltime2 = timesecs/secday - ltime = real(timesecs/secday,kind=real_kind) ! option of turning on double precision history files lprecision = pio_real @@ -186,7 +185,7 @@ subroutine ice_write_hist (ns) ! define dimensions !----------------------------------------------------------------- - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_def_dim(File,'d2',2,boundid) endif @@ -205,13 +204,13 @@ subroutine ice_write_hist (ns) ! define coordinate variables: time, time_bounds !----------------------------------------------------------------- -!sgl status = pio_def_var(File,'time',pio_real,(/timid/),varid) status = pio_def_var(File,'time',pio_double,(/timid/),varid) status = pio_put_att(File,varid,'long_name','model time') write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init status = pio_put_att(File,varid,'units',trim(title)) if (days_per_year == 360) then @@ -224,21 +223,21 @@ subroutine ice_write_hist (ns) call abort_ice(subname//'ERROR: invalid calendar settings') endif - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'bounds','time_bounds') endif ! Define attributes for time_bounds if hist_avg is true - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then dimid2(1) = boundid dimid2(2) = timid -!sgl status = pio_def_var(File,'time_bounds',pio_real,dimid2,varid) status = pio_def_var(File,'time_bounds',pio_double,dimid2,varid) status = pio_put_att(File,varid,'long_name', & 'boundaries for time-averaging interval') write(cdate,'(i8.8)') idate0 - write(title,'(a,a,a,a,a,a,a,a)') 'days since ', & - cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' + write(title,'(a,a4,a1,a2,a1,a2,a1,i2.2,a1,i2.2,a1,i2.2)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' ', & + hh_init,':',mm_init,':',ss_init status = pio_put_att(File,varid,'units',trim(title)) endif @@ -473,7 +472,7 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then if (TRIM(avail_hist_fields(n)%vname)/='sig1' & .or.TRIM(avail_hist_fields(n)%vname)/='sig2' & .or.TRIM(avail_hist_fields(n)%vname)/='sistreave' & @@ -483,7 +482,8 @@ subroutine ice_write_hist (ns) endif endif - if (histfreq(ns) == '1' .or. .not. hist_avg & + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots .or. n==n_sig1(ns) .or. n==n_sig2(ns) & .or. n==n_sigP(ns) .or. n==n_trsig(ns) & @@ -527,11 +527,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -569,11 +570,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -611,11 +613,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -653,11 +656,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -695,11 +699,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -743,11 +748,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -786,11 +792,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -830,11 +837,12 @@ subroutine ice_write_hist (ns) endif ! Add cell_methods attribute to variables if averaged - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_put_att(File,varid,'cell_methods','time: mean') endif - if (histfreq(ns) == '1' .or. .not. hist_avg) then + if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & + .or..not. hist_avg) then status = pio_put_att(File,varid,'time_rep','instantaneous') else status = pio_put_att(File,varid,'time_rep','averaged') @@ -901,14 +909,13 @@ subroutine ice_write_hist (ns) !----------------------------------------------------------------- status = pio_inq_varid(File,'time',varid) -!sgl status = pio_put_var(File,varid,(/1/),ltime) status = pio_put_var(File,varid,(/1/),ltime2) !----------------------------------------------------------------- ! write time_bounds info !----------------------------------------------------------------- - if (hist_avg .and. histfreq(ns) /= '1') then + if (hist_avg) then status = pio_inq_varid(File,'time_bounds',varid) time_bounds=(/time_beg(ns),time_end(ns)/) bnd_start = (/1,1/) diff --git a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 index 4b723a391..d267f77e6 100644 --- a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 +++ b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 @@ -265,29 +265,8 @@ program bcstchk endif endif - ! Test abort_ice, regardless of test outcome - ! Set doabort to false to support code coverage stats, aborted runs don't seem to generate - ! gcov statistics - - call flush_fileunit(6) - call ice_barrier() - if (my_task == master_task) then - write(6,*) ' ' - write(6,*) '==========================================================' - write(6,*) ' ' - write(6,*) 'NOTE: We are testing the abort now so you should see an abort to follow' - write(6,*) 'The BCSTCHK passed, so please ignore the abort' - write(6,*) ' ' - call abort_ice(subname//' Test abort ',file=__FILE__,line=__LINE__, doabort=.false.) - endif - call flush_fileunit(6) - call ice_barrier() - - if (my_task == master_task) then - write(6,*) ' ' - write(6,*) 'BCSTCHK done' - write(6,*) ' ' - endif + ! --------------------------- + ! exit gracefully call end_run() diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 index 345782281..6fa99e4dd 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -15,13 +15,14 @@ program calchk use ice_calendar, only: init_calendar, calendar use ice_calendar, only: set_date_from_timesecs use ice_calendar, only: calendar_date2time, calendar_time2date - use ice_calendar, only: compute_calendar_data + use ice_calendar, only: compute_calendar_data, calendar_sec2hms implicit none integer(kind=int_kind) :: yearmax integer(kind=int_kind) :: nday,nptc integer(kind=int_kind) :: n,m,ny,nm,nd,nf1,nf2,xadd,nfa,nfb,nfc,ns1,ns2 integer(kind=int_kind) :: yi,mi,di,si + integer(kind=int_kind) :: hh,mm,ss integer(kind=int_kind) :: dyear,dmon,dday,dsec integer(kind=int_kind) :: fyear,fmon,fday,fsec character(len=32) :: calstr,unitstr,signstr @@ -29,7 +30,7 @@ program calchk integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month integer (kind=int_kind) :: tdayyr ! days in year - integer(kind=int_kind), parameter :: ntests = 8 + integer(kind=int_kind), parameter :: ntests = 9 character(len=8) :: errorflag0,errorflag(1:ntests),errorflagtmp character(len=32) :: testname(ntests) integer(kind=int_kind) :: yearv(ntests),monv(ntests),dayv(ntests),secv(ntests),ndayv(ntests) ! computed values @@ -54,10 +55,11 @@ program calchk testname(6) = 'small add/sub update_date' testname(7) = 'special checks' testname(8) = 'calc_timesteps' + testname(9) = 'seconds_to_hms' ! test yearmax years from year 0 -! yearmax = 1000 - yearmax = 100000 + yearmax = 1000 +! yearmax = 100000 ! test 3 calendars do n = 1,3 @@ -561,6 +563,26 @@ program calchk endif enddo + !------------------------- + ! calc hms + !------------------------- + + write(6,*) ' ' + do ns1 = 0,86399 + call calendar_sec2hms(ns1,hh,mm,ss) + if (ns1 < 10 .or. ns1 > 86390 .or. (ns1 > 7195 .and. ns1 < 7205)) then + write(6,'(a,i8,2x,i2.2,a,i2.2,a,i2.2)') ' CHECK9 ',ns1,hh,':',mm,':',ss + endif + enddo + monc(9) = 23 ! hh correct result for 86399 + dayc(9) = 59 ! mm correct result for 86399 + secc(9) = 59 ! ss correct result for 86399 + if (hh /= monc(9) .or. mm /= dayc(9) .or. ss /= secc(9)) then + errorflag(9) = failflag + write(6,*) 'ERROR9: hms expected',ns1,monc(9),dayc(9),secc(9) + write(6,*) 'ERROR9: hms error ',ns1,hh,mm,ss + endif + !------------------------- ! write test results !------------------------- diff --git a/cicecore/shared/ice_calendar.F90 b/cicecore/shared/ice_calendar.F90 index f76b3b30b..7684fef67 100644 --- a/cicecore/shared/ice_calendar.F90 +++ b/cicecore/shared/ice_calendar.F90 @@ -47,6 +47,7 @@ module ice_calendar public :: update_date ! input date and delta date, compute new date public :: calendar_date2time ! convert date to time relative to init date public :: calendar_time2date ! convert time to date relative to init date + public :: calendar_sec2hms ! convert seconds to hour, minute, seconds public :: compute_calendar_data ! compute info about calendar for a given year ! private functions @@ -61,8 +62,10 @@ module ice_calendar ice_calendar_360day = '360day' ! 360 day calendar with 30 days per month integer (kind=int_kind), public, parameter :: & - months_per_year = 12, & ! months per year - hours_per_day = 24 ! hours per day + months_per_year = 12, & ! months per year + hours_per_day = 24, & ! hours per day + minutes_per_hour = 60, & ! minutes per hour + seconds_per_minute = 60 ! seconds per minute integer (kind=int_kind), public :: & seconds_per_day , & ! seconds per day @@ -87,6 +90,9 @@ module ice_calendar day_init, & ! initial day of month sec_init , & ! initial seconds ! other stuff + hh_init , & ! initial hour derived from sec_init + mm_init , & ! initial minute derived from sec_init + ss_init , & ! initial second derived from sec_init idate , & ! date (yyyymmdd) idate0 , & ! initial date (yyyymmdd), associated with year_init, month_init, day_init dayyr , & ! number of days in the current year @@ -189,6 +195,7 @@ subroutine init_calendar mmonth=month_init ! month mday=day_init ! day of the month msec=sec_init ! seconds into date + call calendar_sec2hms(sec_init,hh_init,mm_init,ss_init) ! initialize hh,mm,ss _init hour=0 ! computed in calendar, but needs some reasonable initial value istep1 = istep0 ! number of steps at current timestep ! real (dumped) or imagined (use to set calendar) @@ -948,6 +955,28 @@ subroutine calendar_time2date(atimesecs,ayear,amon,aday,asec,year_ref,mon_ref,da end subroutine calendar_time2date +!======================================================================= +! Compute hours, minutes, seconds from seconds + + subroutine calendar_sec2hms(seconds, hh, mm, ss) + + integer(kind=int_kind), intent(in) :: & + seconds ! calendar seconds in day + integer(kind=int_kind), intent(out) :: & + hh, mm, ss ! output hours, minutes, seconds + + character(len=*),parameter :: subname='(calendar_sec2hms)' + + if (seconds >= seconds_per_day) then + write(nu_diag,*) trim(subname),' ERROR seconds >= seconds_per_day, ',seconds,seconds_per_day + call abort_ice(subname//'ERROR: in seconds') + endif + hh = seconds/(seconds_per_hour) + mm = (seconds - hh*seconds_per_hour)/seconds_per_minute + ss = (seconds - hh*seconds_per_hour - mm*seconds_per_minute) + + end subroutine calendar_sec2hms + !======================================================================= ! Compute relative elapsed years, months, days, hours from base time diff --git a/configuration/scripts/options/set_nml.histall b/configuration/scripts/options/set_nml.histall index 758289099..d7a42176e 100644 --- a/configuration/scripts/options/set_nml.histall +++ b/configuration/scripts/options/set_nml.histall @@ -1,5 +1,5 @@ histfreq = 'm','d','1','h','x' - histfreq_n = 1,2,6,4,1 + histfreq_n = 1,2,6,4,5 histfreq_base = 'zero' write_ic = .true. f_tmask = .true. diff --git a/configuration/scripts/options/set_nml.histinst b/configuration/scripts/options/set_nml.histinst new file mode 100644 index 000000000..f2f0995c8 --- /dev/null +++ b/configuration/scripts/options/set_nml.histinst @@ -0,0 +1 @@ +hist_avg = .false. diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts index 6fe1f589a..4d5129578 100644 --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -12,6 +12,7 @@ restart gx3 32x1 gx3ncarbulk,bgcz,histall,iobinary,precision8 restart gx3 16x2 gx3ncarbulk,bgcskl,histall,iobinary restart gx3 14x2 gx3ncarbulk,isotope,histall,iobinary,precision8 restart gx3 16x2 gx3ncarbulk,fsd12,histall,iobinary +restart gx3 8x4 gx3ncarbulk,debug,histall,iobinary,precision8,histinst restart gx3 32x1 debug,histall,ionetcdf restart gx3 15x2 alt01,histall,ionetcdf,precision8,cdf64 @@ -24,6 +25,7 @@ restart gx3 30x1 bgcz,histall,ionetcdf restart gx3 15x2 bgcskl,histall,ionetcdf,precision8 restart gx3 31x1 isotope,histall,ionetcdf,cdf64 restart gx3 14x2 fsd12,histall,ionetcdf,precision8 +restart gx3 32x1 debug,histall,ionetcdf,histinst restart gx3 16x2 debug,histall,iopio1,precision8,cdf64 restart gx3 14x2 alt01,histall,iopio1,cdf64 @@ -36,6 +38,7 @@ restart gx3 16x2 bgcz,histall,iopio1,precision8 restart gx3 30x1 bgcskl,histall,iopio1 restart gx3 8x4 isotope,histall,iopio1,precision8,cdf64 restart gx3 12x2 fsd12,histall,iopio1,cdf64 +restart gx3 16x2 debug,histall,iopio1,precision8,cdf64,histinst restart gx3 16x2 debug,histall,iopio2 restart gx3 14x2 alt01,histall,iopio2,precision8,cdf64 @@ -48,6 +51,7 @@ restart gx3 16x2 bgcz,histall,iopio2,cdf64 restart gx3 30x1 bgcskl,histall,iopio2,precision8 restart gx3 8x4 isotope,histall,iopio2 restart gx3 12x2 fsd12,histall,iopio2,precision8,cdf64 +restart gx3 16x2 debug,histall,iopio2,histinst restart gx3 16x2 debug,histall,iopio1p,precision8 restart gx3 14x2 alt01,histall,iopio1p @@ -60,6 +64,7 @@ restart gx3 16x2 bgcz,histall,iopio1p,precision8,cdf64 restart gx3 30x1 bgcskl,histall,iopio1p,cdf64 restart gx3 8x4 isotope,histall,iopio1p,precision8 restart gx3 12x2 fsd12,histall,iopio1p +restart gx3 16x2 debug,histall,iopio1p,precision8,histinst restart gx3 16x2 debug,histall,iopio2p,cdf64 restart gx3 14x2 alt01,histall,iopio2p,precision8 @@ -72,4 +77,5 @@ restart gx3 16x2 bgcz,histall,iopio2p restart gx3 30x1 bgcskl,histall,iopio2p,precision8,cdf64 restart gx3 8x4 isotope,histall,iopio2p,cdf64 restart gx3 12x2 fsd12,histall,iopio2p,precision8 +restart gx3 16x2 debug,histall,iopio2p,cdf64,histinst diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index f400673ac..cd8f1acaf 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -212,9 +212,6 @@ Known bugs - Latitude and longitude fields in the history output may be wrong when using padding. -- History and restart files will not be written on the first timestep in - some cases. - Interpretation of albedos ---------------------------------------- From 15763d8707dce08a8aeeff2d0886d0fa9a310004 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 10 Aug 2021 17:14:25 -0600 Subject: [PATCH 07/15] revert set_nml.histall --- configuration/scripts/options/set_nml.histall | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configuration/scripts/options/set_nml.histall b/configuration/scripts/options/set_nml.histall index d7a42176e..758289099 100644 --- a/configuration/scripts/options/set_nml.histall +++ b/configuration/scripts/options/set_nml.histall @@ -1,5 +1,5 @@ histfreq = 'm','d','1','h','x' - histfreq_n = 1,2,6,4,5 + histfreq_n = 1,2,6,4,1 histfreq_base = 'zero' write_ic = .true. f_tmask = .true. From b3364a63d056010504ec09d395f8cdd212985e54 Mon Sep 17 00:00:00 2001 From: apcraig Date: Tue, 10 Aug 2021 22:21:33 -0600 Subject: [PATCH 08/15] fix implementation error --- .../cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index b35b44b1b..fd20f4c03 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -483,7 +483,7 @@ subroutine ice_write_hist (ns) endif if ((histfreq(ns) == '1' .and. histfreq_n(ns) == 1) & - .or..not. hist_avg) then + .or..not. hist_avg & .or. n==n_divu(ns) .or. n==n_shear(ns) & ! snapshots .or. n==n_sig1(ns) .or. n==n_sig2(ns) & .or. n==n_sigP(ns) .or. n==n_trsig(ns) & From 96d5851a86cc757751f7d63095d6dde295203d65 Mon Sep 17 00:00:00 2001 From: apcraig Date: Wed, 11 Aug 2021 13:26:01 -0600 Subject: [PATCH 09/15] update model log output in ice_init --- cicecore/cicedynB/general/ice_init.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index c0c089ac8..6aa9280a7 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -1705,13 +1705,13 @@ subroutine input_data write(nu_diag,1023) ' histfreq_n = ', histfreq_n(:) write(nu_diag,1031) ' histfreq_base = ', trim(histfreq_base) write(nu_diag,1011) ' hist_avg = ', hist_avg - if (.not. hist_avg) write(nu_diag,1031) ' History data will be snapshots' + if (.not. hist_avg) write(nu_diag,1039) ' History data will be snapshots' write(nu_diag,1031) ' history_dir = ', trim(history_dir) write(nu_diag,1031) ' history_file = ', trim(history_file) write(nu_diag,1021) ' history_precision= ', history_precision write(nu_diag,1031) ' history_format = ', trim(history_format) if (write_ic) then - write(nu_diag,1031) ' Initial condition will be written in ', & + write(nu_diag,1039) ' Initial condition will be written in ', & trim(incond_dir) endif write(nu_diag,1031) ' dumpfreq = ', trim(dumpfreq) @@ -1878,6 +1878,7 @@ subroutine input_data 1030 format (a20,a14,1x,a) ! character 1031 format (a20,1x,a,a) 1033 format (a20,1x,6a6) + 1039 format (a,1x,a,1x,a,1x,a) end subroutine input_data From 2a692af211a0577927d98d3546726c34caeaccf0 Mon Sep 17 00:00:00 2001 From: Elizabeth Hunke Date: Thu, 12 Aug 2021 15:45:27 -0600 Subject: [PATCH 10/15] Advanced snow physics driver (#621) * initial snow redist/metamorph tracer implementation (no physics) * add rhosmin, snwlvlfac to namelist, change init_snow to init_snowtracers * updating format labels due to changes in Consortium master * add calls to new snow physics routines * update_state after step_snow * fix optional in update_state * wrap step_snow and update_state with tr_snow conditional * snow interactions with thermo (except dEdd) * conflict warning * adding snwgrain namelist flag * use snwredist=bulk instead of 30percent, fix array errors, init snow tracer values, add namelist flags to ice_in * aging lookup table for dry metamorphism (version for testing) * add/clean up diagnostics, begin debugging restart implementation * fixing restarts * add snow tests to base_suite * add history; minor cleanup * fix step_therm1 interface * io fixes for snow1 * bug fix for snow diagnostics * fix line continuation * refactor bgc diagnostics as in Icepack * add snowtable implementation * cleaning up snow test options * send rsnw tracer to dEdd; initialize snow tracers; update -s options for snow * broadcast new snow diagnostics * new snow tests require 5 snow layers and therefore can not start from standard initial condition files with nslyr=1 * update icepack * use local variable for rsnow to prevent array out-of-bound error; cleanup * updating documentation and some code comments * documentation: index * fix history output; include but comment out code for averaging based on snow presence; set rsnw_fall in ice_in for default dEdd and include relevant snow parameters in options files; update doc; clean up * minor cleanup, especially documentation * update icepack Co-authored-by: Andrew Roberts Co-authored-by: Elizabeth Hunke Co-authored-by: apcraig --- .../cicedynB/analysis/ice_diagnostics.F90 | 84 +++- .../cicedynB/analysis/ice_diagnostics_bgc.F90 | 15 +- cicecore/cicedynB/analysis/ice_history.F90 | 60 ++- .../cicedynB/analysis/ice_history_fsd.F90 | 2 +- .../cicedynB/analysis/ice_history_pond.F90 | 8 +- .../cicedynB/analysis/ice_history_shared.F90 | 2 +- .../cicedynB/analysis/ice_history_snow.F90 | 430 ++++++++++++++++++ .../dynamics/ice_transport_driver.F90 | 25 +- cicecore/cicedynB/general/ice_flux.F90 | 7 + cicecore/cicedynB/general/ice_forcing.F90 | 209 ++++++++- cicecore/cicedynB/general/ice_init.F90 | 254 ++++++++++- cicecore/cicedynB/general/ice_step_mod.F90 | 220 +++++++-- .../infrastructure/ice_read_write.F90 | 308 ++++++++++++- .../io/io_binary/ice_restart.F90 | 61 ++- .../io/io_netcdf/ice_restart.F90 | 15 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 15 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 52 ++- .../drivers/standalone/cice/CICE_RunMod.F90 | 27 +- cicecore/shared/ice_arrays_column.F90 | 11 + cicecore/shared/ice_fileunits.F90 | 6 + cicecore/shared/ice_init_column.F90 | 77 +++- cicecore/shared/ice_restart_column.F90 | 91 +++- configuration/scripts/ice_in | 39 ++ .../scripts/options/set_nml.snw30percent | 5 + .../scripts/options/set_nml.snwITDrdg | 10 + .../scripts/options/set_nml.snwgrain | 15 + configuration/scripts/tests/base_suite.ts | 3 + doc/source/cice_index.rst | 34 +- doc/source/developer_guide/dg_driver.rst | 11 +- doc/source/science_guide/sg_tracers.rst | 6 +- doc/source/user_guide/ug_case_settings.rst | 35 ++ icepack | 2 +- 32 files changed, 1993 insertions(+), 146 deletions(-) create mode 100644 cicecore/cicedynB/analysis/ice_history_snow.F90 create mode 100644 configuration/scripts/options/set_nml.snw30percent create mode 100644 configuration/scripts/options/set_nml.snwITDrdg create mode 100644 configuration/scripts/options/set_nml.snwgrain diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index 760952fc5..d4e7066fb 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -14,6 +14,7 @@ module ice_diagnostics use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1 use ice_calendar, only: istep1 + use ice_domain_size, only: nslyr use ice_fileunits, only: nu_diag use ice_fileunits, only: flush_fileunit use ice_exit, only: abort_ice @@ -142,15 +143,19 @@ subroutine runtime_diags (dt) i, j, k, n, iblk, nc, & ktherm, & nt_tsfc, nt_aero, nt_fbri, nt_apnd, nt_hpnd, nt_fsd, & - nt_isosno, nt_isoice + nt_isosno, nt_isoice, nt_rsnw, nt_rhos, nt_smice, nt_smliq logical (kind=log_kind) :: & - tr_pond_topo, tr_brine, tr_iso, tr_aero, calc_Tsfc, tr_fsd + tr_pond_topo, tr_brine, tr_iso, tr_aero, calc_Tsfc, tr_fsd, & + tr_snow, snwgrain real (kind=dbl_kind) :: & rhow, rhos, rhoi, puny, awtvdr, awtidr, awtvdf, awtidf, & rhofresh, lfresh, lvap, ice_ref_salinity, Tffresh + character (len=char_len) :: & + snwredist + ! hemispheric state quantities real (kind=dbl_kind) :: & umaxn, hmaxn, shmaxn, arean, snwmxn, extentn, shmaxnt, & @@ -190,7 +195,8 @@ subroutine runtime_diags (dt) pTsfc, pevap, pfswabs, pflwout, pflat, pfsens, & pfsurf, pfcondtop, psst, psss, pTf, hiavg, hsavg, hbravg, & pfhocn, psalt, fsdavg, & - pmeltt, pmeltb, pmeltl, psnoice, pdsnow, pfrazil, pcongel + pmeltt, pmeltb, pmeltl, psnoice, pdsnow, pfrazil, pcongel, & + prsnwavg, prhosavg, psmicetot, psmliqtot, psmtot real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1, work2 @@ -199,15 +205,19 @@ subroutine runtime_diags (dt) call icepack_query_parameters(ktherm_out=ktherm, calc_Tsfc_out=calc_Tsfc) call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_aero_out=tr_aero, & - tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_fbri_out=nt_fbri, nt_Tsfc_out=nt_Tsfc, & nt_aero_out=nt_aero, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & - nt_fsd_out=nt_fsd,nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_fsd_out=nt_fsd,nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_rsnw_out=nt_rsnw, nt_rhos_out=nt_rhos, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) call icepack_query_parameters(Tffresh_out=Tffresh, rhos_out=rhos, & rhow_out=rhow, rhoi_out=rhoi, puny_out=puny, & awtvdr_out=awtvdr, awtidr_out=awtidr, awtvdf_out=awtvdf, awtidf_out=awtidf, & rhofresh_out=rhofresh, lfresh_out=lfresh, lvap_out=lvap, & - ice_ref_salinity_out=ice_ref_salinity) + ice_ref_salinity_out=ice_ref_salinity,snwredist_out=snwredist, & + snwgrain_out=snwgrain) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -825,6 +835,26 @@ subroutine runtime_diags (dt) enddo endif endif + if (tr_snow) then ! snow tracer quantities + prsnwavg (n) = c0 ! avg snow grain radius + prhosavg (n) = c0 ! avg snow density + psmicetot(n) = c0 ! total mass of ice in snow (kg/m2) + psmliqtot(n) = c0 ! total mass of liquid in snow (kg/m2) + psmtot (n) = c0 ! total mass of snow volume (kg/m2) + if (vsno(i,j,iblk) > c0) then + do k = 1, nslyr + prsnwavg (n) = prsnwavg (n) + trcr(i,j,nt_rsnw +k-1,iblk) ! snow grain radius + prhosavg (n) = prhosavg (n) + trcr(i,j,nt_rhos +k-1,iblk) ! compacted snow density + psmicetot(n) = psmicetot(n) + trcr(i,j,nt_smice+k-1,iblk) * vsno(i,j,iblk) + psmliqtot(n) = psmliqtot(n) + trcr(i,j,nt_smliq+k-1,iblk) * vsno(i,j,iblk) + end do + endif + psmtot (n) = rhos * vsno(i,j,iblk) ! mass of ice in standard density snow + prsnwavg (n) = prsnwavg (n) / real(nslyr,kind=dbl_kind) ! snow grain radius + prhosavg (n) = prhosavg (n) / real(nslyr,kind=dbl_kind) ! compacted snow density + psmicetot(n) = psmicetot(n) / real(nslyr,kind=dbl_kind) ! mass of ice in snow + psmliqtot(n) = psmliqtot(n) / real(nslyr,kind=dbl_kind) ! mass of liquid in snow + end if psalt(n) = c0 if (vice(i,j,iblk) /= c0) psalt(n) = work2(i,j,iblk)/vice(i,j,iblk) pTsfc(n) = trcr(i,j,nt_Tsfc,iblk) ! ice/snow sfc temperature @@ -877,6 +907,11 @@ subroutine runtime_diags (dt) call broadcast_scalar(pmeltl (n), pmloc(n)) call broadcast_scalar(psnoice (n), pmloc(n)) call broadcast_scalar(pdsnow (n), pmloc(n)) + call broadcast_scalar(psmtot (n), pmloc(n)) + call broadcast_scalar(prsnwavg (n), pmloc(n)) + call broadcast_scalar(prhosavg (n), pmloc(n)) + call broadcast_scalar(psmicetot(n), pmloc(n)) + call broadcast_scalar(psmliqtot(n), pmloc(n)) call broadcast_scalar(pfrazil (n), pmloc(n)) call broadcast_scalar(pcongel (n), pmloc(n)) call broadcast_scalar(pdhi (n), pmloc(n)) @@ -1060,6 +1095,26 @@ subroutine runtime_diags (dt) write(nu_diag,900) 'effective dhi (m) = ',pdhi(1),pdhi(2) write(nu_diag,900) 'effective dhs (m) = ',pdhs(1),pdhs(2) write(nu_diag,900) 'intnl enrgy chng(W/m^2)= ',pde (1),pde (2) + + if (tr_snow) then + if (trim(snwredist) /= 'none') then + write(nu_diag,900) 'avg snow density(kg/m3)= ',prhosavg(1) & + ,prhosavg(2) + endif + if (snwgrain) then + write(nu_diag,900) 'avg snow grain radius = ',prsnwavg(1) & + ,prsnwavg(2) + write(nu_diag,900) 'mass ice in snow(kg/m2)= ',psmicetot(1) & + ,psmicetot(2) + write(nu_diag,900) 'mass liq in snow(kg/m2)= ',psmliqtot(1) & + ,psmliqtot(2) + write(nu_diag,900) 'mass std snow (kg/m2)= ',psmtot(1) & + ,psmtot(2) + write(nu_diag,900) 'max ice+liq (kg/m2)= ',rhow * hsavg(1) & + ,rhow * hsavg(2) + endif + endif + write(nu_diag,*) '----------ocn----------' write(nu_diag,900) 'sst (C) = ',psst(1),psst(2) write(nu_diag,900) 'sss (ppt) = ',psss(1),psss(2) @@ -1597,19 +1652,21 @@ subroutine print_state(plabel,i,j,iblk) rad_to_deg, puny, rhoi, lfresh, rhos, cp_ice integer (kind=int_kind) :: n, k, nt_Tsfc, nt_qice, nt_qsno, nt_fsd, & - nt_isosno, nt_isoice, nt_sice + nt_isosno, nt_isoice, nt_sice, nt_smice, nt_smliq - logical (kind=log_kind) :: tr_fsd, tr_iso + logical (kind=log_kind) :: tr_fsd, tr_iso, tr_snow type (block) :: & this_block ! block information for current block character(len=*), parameter :: subname = '(print_state)' - call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_iso_out=tr_iso, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fsd_out=nt_fsd, & - nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) call icepack_query_parameters( & rad_to_deg_out=rad_to_deg, puny_out=puny, rhoi_out=rhoi, lfresh_out=lfresh, & rhos_out=rhos, cp_ice_out=cp_ice) @@ -1639,8 +1696,11 @@ subroutine print_state(plabel,i,j,iblk) endif write(nu_diag,*) 'Tsfcn',trcrn(i,j,nt_Tsfc,n,iblk) if (tr_fsd) write(nu_diag,*) 'afsdn',trcrn(i,j,nt_fsd,n,iblk) ! fsd cat 1 -! if (tr_iso) write(nu_diag,*) 'isosno',trcrn(i,j,nt_isosno,n,iblk) ! isotopes in snow -! if (tr_iso) write(nu_diag,*) 'isoice',trcrn(i,j,nt_isoice,n,iblk) ! isotopes in ice +! layer 1 diagnostics +! if (tr_iso) write(nu_diag,*) 'isosno',trcrn(i,j,nt_isosno,n,iblk) ! isotopes in snow +! if (tr_iso) write(nu_diag,*) 'isoice',trcrn(i,j,nt_isoice,n,iblk) ! isotopes in ice +! if (tr_snow) write(nu_diag,*) 'smice', trcrn(i,j,nt_smice, n,iblk) ! ice mass in snow +! if (tr_snow) write(nu_diag,*) 'smliq', trcrn(i,j,nt_smliq, n,iblk) ! liquid mass in snow write(nu_diag,*) ' ' ! dynamics (transport and/or ridging) causes the floe size distribution to become non-normal diff --git a/cicecore/cicedynB/analysis/ice_diagnostics_bgc.F90 b/cicecore/cicedynB/analysis/ice_diagnostics_bgc.F90 index fa965dfe0..74485a5e2 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics_bgc.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics_bgc.F90 @@ -937,19 +937,18 @@ subroutine zsal_diags enddo if (aice(i,j,iblk) > c0) & psice_rho(n) = psice_rho(n)/aice(i,j,iblk) - if (tr_brine .and. aice(i,j,iblk) > c0) & + if (tr_brine .and. aice(i,j,iblk) > c0) then phinS(n) = trcr(i,j,nt_fbri,iblk)*vice(i,j,iblk)/aice(i,j,iblk) - - if (aicen(i,j,1,iblk)> c0) then - if (tr_brine) phinS1(n) = trcrn(i,j,nt_fbri,1,iblk) & - * vicen(i,j,1,iblk)/aicen(i,j,1,iblk) + phbrn(n) = (c1 - rhosi/rhow)*vice(i,j,iblk)/aice(i,j,iblk) & + - rhos/rhow *vsno(i,j,iblk)/aice(i,j,iblk) + endif + if (tr_brine .and. aicen(i,j,1,iblk)> c0) then + phinS1(n) = trcrn(i,j,nt_fbri,1,iblk) & + * vicen(i,j,1,iblk)/aicen(i,j,1,iblk) pdh_top1(n) = dhbr_top(i,j,1,iblk) pdh_bot1(n) = dhbr_bot(i,j,1,iblk) pdarcy_V1(n) = darcy_V(i,j,1,iblk) endif - if (tr_brine .AND. aice(i,j,iblk) > c0) & - phbrn(n) = (c1 - rhosi/rhow)*vice(i,j,iblk)/aice(i,j,iblk) & - - rhos/rhow *vsno(i,j,iblk)/aice(i,j,iblk) do k = 1, nblyr+1 pbTiz(n,k) = c0 piDin(n,k) = c0 diff --git a/cicecore/cicedynB/analysis/ice_history.F90 b/cicecore/cicedynB/analysis/ice_history.F90 index f91562449..87bcba3f9 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -67,10 +67,11 @@ subroutine init_hist (dt) histfreq_n, nstreams use ice_domain_size, only: max_blocks, max_nstrm, nilyr, nslyr, nblyr, ncat, nfsd use ice_dyn_shared, only: kdyn - use ice_flux, only: mlt_onset, frz_onset, albcnt + use ice_flux, only: mlt_onset, frz_onset, albcnt, snwcnt use ice_history_shared ! everything use ice_history_mechred, only: init_hist_mechred_2D, init_hist_mechred_3Dc use ice_history_pond, only: init_hist_pond_2D, init_hist_pond_3Dc + use ice_history_snow, only: init_hist_snow_2D, init_hist_snow_3Dc use ice_history_bgc, only:init_hist_bgc_2D, init_hist_bgc_3Dc, & init_hist_bgc_3Db, init_hist_bgc_3Da use ice_history_drag, only: init_hist_drag_2D @@ -86,7 +87,7 @@ subroutine init_hist (dt) real (kind=dbl_kind) :: rhofresh, Tffresh, secday, rad_to_deg logical (kind=log_kind) :: formdrag logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_brine - logical (kind=log_kind) :: tr_fsd + logical (kind=log_kind) :: tr_fsd, tr_snow logical (kind=log_kind) :: skl_bgc, solve_zsal, solve_zbgc, z_tracers integer (kind=int_kind) :: n, ns, ns1, ns2 integer (kind=int_kind), dimension(max_nstrm) :: & @@ -115,7 +116,7 @@ subroutine init_hist (dt) solve_zsal_out=solve_zsal, solve_zbgc_out=solve_zbgc, z_tracers_out=z_tracers) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_out=tr_pond, tr_aero_out=tr_aero, & - tr_brine_out=tr_brine, tr_fsd_out=tr_fsd) + tr_brine_out=tr_brine, 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__) @@ -1426,6 +1427,9 @@ subroutine init_hist (dt) ! floe size distribution call init_hist_fsd_2D + ! advanced snow physics + call init_hist_snow_2D (dt) + !----------------------------------------------------------------- ! 3D (category) variables looped separately for ordering !----------------------------------------------------------------- @@ -1501,6 +1505,9 @@ subroutine init_hist (dt) ! biogeochemistry call init_hist_bgc_3Dc + ! advanced snow physics + call init_hist_snow_3Dc + !----------------------------------------------------------------- ! 3D (vertical) variables must be looped separately !----------------------------------------------------------------- @@ -1688,6 +1695,7 @@ subroutine init_hist (dt) if (allocated(a4Df)) a4Df(:,:,:,:,:,:) = c0 avgct(:) = c0 albcnt(:,:,:,:) = c0 + snwcnt(:,:,:,:) = c0 if (restart .and. yday >= c2) then ! restarting midyear gives erroneous onset dates @@ -1726,7 +1734,7 @@ subroutine accum_hist (dt) fhocn, fhocn_ai, uatm, vatm, fbot, Tbot, Tsnice, & fswthru_ai, strairx, strairy, strtltx, strtlty, strintx, strinty, & taubx, tauby, strocnx, strocny, fm, daidtt, dvidtt, daidtd, dvidtd, fsurf, & - fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, & + fcondtop, fcondbot, fsurfn, fcondtopn, flatn, fsensn, albcnt, snwcnt, & stressp_1, stressm_1, stress12_1, & stressp_2, & stressp_3, & @@ -1739,6 +1747,8 @@ subroutine accum_hist (dt) use ice_history_bgc, only: accum_hist_bgc use ice_history_mechred, only: accum_hist_mechred use ice_history_pond, only: accum_hist_pond + use ice_history_snow, only: accum_hist_snow, & + f_rhos_cmp, f_rhos_cnt, n_rhos_cmp, n_rhos_cnt use ice_history_drag, only: accum_hist_drag use icepack_intfc, only: icepack_mushy_density_brine, icepack_mushy_liquid_fraction use icepack_intfc, only: icepack_mushy_temperature_mush @@ -1775,7 +1785,7 @@ subroutine accum_hist (dt) real (kind=dbl_kind) :: Tffresh, rhoi, rhos, rhow, ice_ref_salinity real (kind=dbl_kind) :: rho_ice, rho_ocn, Tice, Sbr, phi, rhob, dfresh, dfsalt logical (kind=log_kind) :: formdrag, skl_bgc - logical (kind=log_kind) :: tr_pond, tr_aero, tr_brine + logical (kind=log_kind) :: tr_pond, tr_aero, tr_brine, tr_snow integer (kind=int_kind) :: ktherm integer (kind=int_kind) :: nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY, nt_Tsfc, & nt_alvl, nt_vlvl @@ -1791,7 +1801,7 @@ subroutine accum_hist (dt) rhow_out=rhow, ice_ref_salinity_out=ice_ref_salinity) call icepack_query_parameters(formdrag_out=formdrag, skl_bgc_out=skl_bgc, ktherm_out=ktherm) call icepack_query_tracer_flags(tr_pond_out=tr_pond, tr_aero_out=tr_aero, & - tr_brine_out=tr_brine) + tr_brine_out=tr_brine, tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_sice_out=nt_sice, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_Tsfc_out=nt_Tsfc, & nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) @@ -3040,6 +3050,9 @@ subroutine accum_hist (dt) ! floe size distribution call accum_hist_fsd (iblk) + ! advanced snow physics + call accum_hist_snow (iblk) + enddo ! iblk !$OMP END PARALLEL DO @@ -3669,7 +3682,38 @@ subroutine accum_hist (dt) enddo ! j endif - endif +! snwcnt averaging is not working correctly +! for now, these history fields will have zeroes includes in the averages +! if (avail_hist_fields(n)%vname(1:8) == 'rhos_cmp') then +! do j = jlo, jhi +! do i = ilo, ihi +! if (tmask(i,j,iblk)) then +! ravgctz = c0 +! if (snwcnt(i,j,iblk,ns) > puny) & +! ravgctz = c1/snwcnt(i,j,iblk,ns) +! if (f_rhos_cmp (1:1) /= 'x' .and. n_rhos_cmp(ns) /= 0) & +! a2D(i,j,n_rhos_cmp(ns),iblk) = & +! a2D(i,j,n_rhos_cmp(ns),iblk)*avgct(ns)*ravgctz +! endif +! enddo ! i +! enddo ! j +! endif +! if (avail_hist_fields(n)%vname(1:8) == 'rhos_cnt') then +! do j = jlo, jhi +! do i = ilo, ihi +! if (tmask(i,j,iblk)) then +! ravgctz = c0 +! if (snwcnt(i,j,iblk,ns) > puny) & +! ravgctz = c1/snwcnt(i,j,iblk,ns) +! if (f_rhos_cnt (1:1) /= 'x' .and. n_rhos_cnt(ns) /= 0) & +! a2D(i,j,n_rhos_cnt(ns),iblk) = & +! a2D(i,j,n_rhos_cnt(ns),iblk)*avgct(ns)*ravgctz +! endif +! enddo ! i +! enddo ! j +! endif + + endif ! avail_hist_fields(n)%vhistfreq == histfreq(ns) enddo ! n do n = 1, num_avail_hist_fields_3Dc @@ -3992,10 +4036,12 @@ subroutine accum_hist (dt) if (allocated(a4Df)) a4Df(:,:,:,:,:,:) = c0 avgct(:) = c0 albcnt(:,:,:,:) = c0 + snwcnt(:,:,:,:) = c0 write_ic = .false. ! write initial condition once at most else avgct(ns) = c0 albcnt(:,:,:,ns) = c0 + snwcnt(:,:,:,ns) = c0 endif ! if (write_history(ns)) albcnt(:,:,:,ns) = c0 diff --git a/cicecore/cicedynB/analysis/ice_history_fsd.F90 b/cicecore/cicedynB/analysis/ice_history_fsd.F90 index 43afc1e27..7ad81e7d2 100644 --- a/cicecore/cicedynB/analysis/ice_history_fsd.F90 +++ b/cicecore/cicedynB/analysis/ice_history_fsd.F90 @@ -303,7 +303,7 @@ subroutine accum_hist_fsd (iblk) integer (kind=int_kind) :: & i, j, n, k, & ! loop indices - nt_fsd ! ! fsd tracer index + nt_fsd ! fsd tracer index logical (kind=log_kind) :: tr_fsd real (kind=dbl_kind) :: floeshape, puny diff --git a/cicecore/cicedynB/analysis/ice_history_pond.F90 b/cicecore/cicedynB/analysis/ice_history_pond.F90 index de10eb9fb..182865fec 100644 --- a/cicecore/cicedynB/analysis/ice_history_pond.F90 +++ b/cicecore/cicedynB/analysis/ice_history_pond.F90 @@ -75,15 +75,15 @@ subroutine init_hist_pond_2D logical (kind=log_kind) :: tr_pond character(len=*), parameter :: subname = '(init_hist_pond_2D)' - !----------------------------------------------------------------- - ! read namelist - !----------------------------------------------------------------- - call icepack_query_tracer_flags(tr_pond_out=tr_pond) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + !----------------------------------------------------------------- + ! read namelist + !----------------------------------------------------------------- + call get_fileunit(nu_nml) if (my_task == master_task) then open (nu_nml, file=nml_filename, status='old',iostat=nml_error) diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index 52d268990..9297d78c9 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -59,7 +59,7 @@ module ice_history_shared !--------------------------------------------------------------- ! Instructions for adding a field: (search for 'example') - ! Here: + ! Here or in ice_history_[process].F90: ! (1) Add to frequency flags (f_) ! (2) Add to namelist (here and also in ice_in) ! (3) Add to index list diff --git a/cicecore/cicedynB/analysis/ice_history_snow.F90 b/cicecore/cicedynB/analysis/ice_history_snow.F90 new file mode 100644 index 000000000..5a590af2b --- /dev/null +++ b/cicecore/cicedynB/analysis/ice_history_snow.F90 @@ -0,0 +1,430 @@ +!======================================================================= + +! Snow tracer history output + + module ice_history_snow + + use ice_kinds_mod + use ice_constants, only: c0, c1, mps_to_cmpdy + use ice_domain_size, only: max_nstrm, nslyr + use ice_fileunits, only: nu_nml, nml_filename, & + get_fileunit, release_fileunit + use ice_fileunits, only: nu_diag + use ice_exit, only: abort_ice + 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 + + implicit none + private + public :: accum_hist_snow, init_hist_snow_2D, init_hist_snow_3Dc + + !--------------------------------------------------------------- + ! flags: write to output file if true or histfreq value + !--------------------------------------------------------------- + + character (len=max_nstrm), public :: & + f_smassice = 'm', f_smassicen = 'x', & + f_smassliq = 'm', f_smassliqn = 'x', & + f_rhos_cmp = 'm', f_rhos_cmpn = 'x', & + f_rhos_cnt = 'm', f_rhos_cntn = 'x', & + f_rsnw = 'm', f_rsnwn = 'x', & + f_meltsliq = 'm', f_fsloss = 'x' + + !--------------------------------------------------------------- + ! namelist variables + !--------------------------------------------------------------- + + namelist / icefields_snow_nml / & + f_smassice, f_smassicen, & + f_smassliq, f_smassliqn, & + f_rhos_cmp, f_rhos_cmpn, & + f_rhos_cnt, f_rhos_cntn, & + f_rsnw, f_rsnwn, & + f_meltsliq, f_fsloss + + !--------------------------------------------------------------- + ! field indices + !--------------------------------------------------------------- + + integer (kind=int_kind), dimension(max_nstrm), public :: & + n_smassice, n_smassicen, & + n_smassliq, n_smassliqn, & + n_rhos_cmp, n_rhos_cmpn, & + n_rhos_cnt, n_rhos_cntn, & + n_rsnw, n_rsnwn, & + n_meltsliq, n_fsloss + +!======================================================================= + + contains + +!======================================================================= + + subroutine init_hist_snow_2D (dt) + + use ice_broadcast, only: broadcast_scalar + use ice_calendar, only: nstreams, histfreq + use ice_communicate, only: my_task, master_task + use ice_history_shared, only: tstr2D, tcstr, define_hist_field + use ice_fileunits, only: nu_nml, nml_filename, & + get_fileunit, release_fileunit + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + integer (kind=int_kind) :: ns + integer (kind=int_kind) :: nml_error ! namelist i/o error flag + real (kind=dbl_kind) :: rhofresh, secday + logical (kind=log_kind) :: tr_snow + character(len=*), parameter :: subname = '(init_hist_snow_2D)' + + call icepack_query_tracer_flags(tr_snow_out=tr_snow) + call icepack_query_parameters(rhofresh_out=rhofresh,secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (tr_snow) then + + !----------------------------------------------------------------- + ! read namelist + !----------------------------------------------------------------- + + call get_fileunit(nu_nml) + if (my_task == master_task) then + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nu_nml, nml=icefields_snow_nml,iostat=nml_error) + end do + if (nml_error == 0) close(nu_nml) + endif + call release_fileunit(nu_nml) + + call broadcast_scalar(nml_error, master_task) + if (nml_error /= 0) then + close (nu_nml) + call abort_ice('ice: error reading icefields_snow_nml') + endif + + else ! .not. tr_snow + f_smassice = 'x' + f_smassliq = 'x' + f_rhos_cmp = 'x' + f_rhos_cnt = 'x' + f_rsnw = 'x' + f_smassicen= 'x' + f_smassliqn= 'x' + f_rhos_cmpn= 'x' + f_rhos_cntn= 'x' + f_rsnwn = 'x' + f_meltsliq = 'x' + f_fsloss = 'x' + endif + + call broadcast_scalar (f_smassice, master_task) + call broadcast_scalar (f_smassliq, master_task) + call broadcast_scalar (f_rhos_cmp, master_task) + call broadcast_scalar (f_rhos_cnt, master_task) + call broadcast_scalar (f_rsnw, master_task) + call broadcast_scalar (f_smassicen,master_task) + call broadcast_scalar (f_smassliqn,master_task) + call broadcast_scalar (f_rhos_cmpn,master_task) + call broadcast_scalar (f_rhos_cntn,master_task) + call broadcast_scalar (f_rsnwn, master_task) + call broadcast_scalar (f_meltsliq, master_task) + call broadcast_scalar (f_fsloss, master_task) + + if (tr_snow) then + + ! 2D variables + do ns = 1, nstreams + if (histfreq(ns) /= 'x') then + + if (f_smassice(1:1) /= 'x') & + call define_hist_field(n_smassice,"smassice","kg/m^2",tstr2D, tcstr, & + "ice mass per unit area in snow", & + "none", c1, c0, & + ns, f_smassice) + + if (f_smassliq(1:1) /= 'x') & + call define_hist_field(n_smassliq,"smassliq","kg/m^2",tstr2D, tcstr, & + "liquid mass per unit area in snow", & + "none", c1, c0, & + ns, f_smassliq) + + if (f_rhos_cmp(1:1) /= 'x') & + call define_hist_field(n_rhos_cmp,"rhos_cmp","kg/m^3",tstr2D, tcstr, & + "snow density: compaction", & + "none", c1, c0, & + ns, f_rhos_cmp) + + if (f_rhos_cnt(1:1) /= 'x') & + call define_hist_field(n_rhos_cnt,"rhos_cnt","kg/m^3",tstr2D, tcstr, & + "snow density: content", & + "none", c1, c0, & + ns, f_rhos_cnt) + + if (f_rsnw(1:1) /= 'x') & + call define_hist_field(n_rsnw,"rsnw","10^-6 m",tstr2D, tcstr, & + "average snow grain radius", & + "none", c1, c0, & + ns, f_rsnw) + + if (f_meltsliq(1:1) /= 'x') & + call define_hist_field(n_meltsliq,"meltsliq","kg/m^2/s",tstr2D, tcstr, & + "snow liquid contribution to meltponds", & + "none", c1/dt, c0, & + ns, f_meltsliq) + + if (f_fsloss(1:1) /= 'x') & + call define_hist_field(n_fsloss,"fsloss","kg/m^2/s",tstr2D, tcstr, & + "rate of snow loss to leads (liquid)", & + "none", c1, c0, & + ns, f_fsloss) + + endif ! histfreq(ns) /= 'x' + enddo ! nstreams + endif ! tr_snow + + end subroutine init_hist_snow_2D + +!======================================================================= + + subroutine init_hist_snow_3Dc + + use ice_calendar, only: nstreams, histfreq + use ice_history_shared, only: tstr3Dc, tcstr, define_hist_field + + integer (kind=int_kind) :: ns + logical (kind=log_kind) :: tr_snow + character(len=*), parameter :: subname = '(init_hist_pond_3Dc)' + + call icepack_query_tracer_flags(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__) + + if (tr_snow) then + + ! 3D (category) variables must be looped separately + do ns = 1, nstreams + if (histfreq(ns) /= 'x') then + + if (f_smassicen(1:1) /= 'x') & + call define_hist_field(n_smassicen,"smassicen","kg/m^2",tstr3Dc, tcstr, & + "ice mass per unit area in snow, category", & + "none", c1, c0, & + ns, f_smassicen) + + if (f_smassliqn(1:1) /= 'x') & + call define_hist_field(n_smassliqn,"smassliqn","kg/m^2",tstr3Dc, tcstr, & + "liquid mass per unit area in snow, category", & + "none", c1, c0, & + ns, f_smassliqn) + + if (f_rhos_cmpn(1:1) /= 'x') & + call define_hist_field(n_rhos_cmpn,"rhos_cmpn","kg/m^3",tstr3Dc, tcstr, & + "snow density: compaction, category", & + "none", c1, c0, & + ns, f_rhos_cmpn) + + if (f_rhos_cntn(1:1) /= 'x') & + call define_hist_field(n_rhos_cntn,"rhos_cntn","kg/m^3",tstr3Dc, tcstr, & + "snow density: content, category", & + "none", c1, c0, & + ns, f_rhos_cntn) + + if (f_rsnwn(1:1) /= 'x') & + call define_hist_field(n_rsnwn,"rsnwn","10^-6 m",tstr3Dc, tcstr, & + "average snow grain radius, category", & + "none", c1, c0, & + ns, f_rsnwn) + + endif ! histfreq(ns) /= 'x' + enddo ! ns + + endif ! tr_snow + + end subroutine init_hist_snow_3Dc + +!======================================================================= + +! accumulate average ice quantities or snapshots + + subroutine accum_hist_snow (iblk) + + use ice_arrays_column, only: meltsliq + use ice_blocks, only: block, nx_block, ny_block + use ice_domain, only: blocks_ice + use ice_flux, only: fsloss + use ice_history_shared, only: n2D, a2D, a3Dc, ncat_hist, & + accum_hist_field, nzslyr + use ice_state, only: vsno, vsnon, trcr, trcrn + + integer (kind=int_kind), intent(in) :: & + iblk ! block index + + ! local variables + + integer (kind=int_kind) :: & + i, j, k, n + + integer (kind=int_kind) :: & + nt_smice, nt_smliq, nt_rhos, nt_rsnw + + logical (kind=log_kind) :: tr_snow + + real (kind=dbl_kind), dimension (nx_block,ny_block) :: & + worka + + real (kind=dbl_kind), dimension (nx_block,ny_block,ncat_hist) :: & + workb + + character(len=*), parameter :: subname = '(accum_hist_snow)' + + !--------------------------------------------------------------- + ! increment field + !--------------------------------------------------------------- + + call icepack_query_tracer_flags(tr_snow_out=tr_snow) + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, 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__) + + if (allocated(a2D)) then + if (tr_snow) then + + if (f_smassice(1:1)/= 'x') then + worka(:,:) = c0 + do k = 1, nzslyr + worka(:,:) = worka(:,:) & + + trcr(:,:,nt_smice+k-1,iblk) + enddo + worka(:,:) = worka(:,:) * vsno(:,:,iblk) / real(nslyr,kind=dbl_kind) + call accum_hist_field(n_smassice, iblk, worka, a2D) + endif + if (f_smassliq(1:1)/= 'x') then + worka(:,:) = c0 + do k = 1, nzslyr + worka(:,:) = worka(:,:) & + + trcr(:,:,nt_smliq+k-1,iblk) + enddo + worka(:,:) = worka(:,:) * vsno(:,:,iblk) / real(nslyr,kind=dbl_kind) + call accum_hist_field(n_smassliq, iblk, worka, a2D) + endif + if (f_rhos_cmp(1:1)/= 'x') then + worka(:,:) = c0 + do k = 1, nzslyr + worka(:,:) = worka(:,:) & + + trcr(:,:,nt_rhos+k-1,iblk) + enddo + worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind) + call accum_hist_field(n_rhos_cmp, iblk, worka, a2D) + endif + if (f_rhos_cnt(1:1)/= 'x') then + worka(:,:) = c0 + do k = 1, nzslyr + worka(:,:) = worka(:,:) & + + trcr(:,:,nt_smice+k-1,iblk) & + + trcr(:,:,nt_smliq+k-1,iblk) + enddo + worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind) + call accum_hist_field(n_rhos_cnt, iblk, worka, a2D) + endif + if (f_rsnw(1:1)/= 'x') then + worka(:,:) = c0 + do k = 1, nzslyr + worka(:,:) = worka(:,:) & + + trcr(:,:,nt_rsnw+k-1,iblk) + enddo + worka(:,:) = worka(:,:) / real(nslyr,kind=dbl_kind) + call accum_hist_field(n_rsnw, iblk, worka, a2D) + endif + if (f_meltsliq(1:1)/= 'x') & + call accum_hist_field(n_meltsliq, iblk, & + meltsliq(:,:,iblk), a2D) + if (f_fsloss(1:1)/= 'x') & + call accum_hist_field(n_fsloss, iblk, & + fsloss(:,:,iblk), a2D) + + endif ! allocated(a2D) + + ! 3D category fields + if (allocated(a3Dc)) then + if (f_smassicen(1:1)/= 'x') then + workb(:,:,:) = c0 + do n = 1, ncat_hist + do k = 1, nzslyr + workb(:,:,n) = workb(:,:,n) & + + trcrn(:,:,nt_smice+k-1,n,iblk) + enddo + workb(:,:,n) = workb(:,:,n) & + * vsnon(:,:,n,iblk) / real(nslyr,kind=dbl_kind) + enddo + call accum_hist_field(n_smassicen-n2D, iblk, ncat_hist, workb, a3Dc) + endif + if (f_smassliqn(1:1)/= 'x') then + workb(:,:,:) = c0 + do n = 1, ncat_hist + do k = 1, nzslyr + workb(:,:,n) = workb(:,:,n) & + + trcrn(:,:,nt_smliq+k-1,n,iblk) + enddo + workb(:,:,n) = workb(:,:,n) & + * vsnon(:,:,n,iblk) / real(nslyr,kind=dbl_kind) + enddo + call accum_hist_field(n_smassliqn-n2D, iblk, ncat_hist, workb, a3Dc) + endif + if (f_rhos_cmpn(1:1)/= 'x') then + workb(:,:,:) = c0 + do n = 1, ncat_hist + do k = 1, nzslyr + workb(:,:,n) = workb(:,:,n) & + + trcrn(:,:,nt_rhos+k-1,n,iblk) + enddo + workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind) + enddo + call accum_hist_field(n_rhos_cmpn-n2D, iblk, ncat_hist, workb, a3Dc) + endif + if (f_rhos_cntn(1:1)/= 'x') then + workb(:,:,:) = c0 + do n = 1, ncat_hist + do k = 1, nzslyr + workb(:,:,n) = workb(:,:,n) & + + trcrn(:,:,nt_smice+k-1,n,iblk) & + + trcrn(:,:,nt_smliq+k-1,n,iblk) + enddo + workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind) + enddo + call accum_hist_field(n_rhos_cntn-n2D, iblk, ncat_hist, workb, a3Dc) + endif + if (f_rsnwn(1:1)/= 'x') then + workb(:,:,:) = c0 + do n = 1, ncat_hist + do k = 1, nzslyr + workb(:,:,n) = workb(:,:,n) & + + trcrn(:,:,nt_rsnw+k-1,n,iblk) + enddo + workb(:,:,n) = workb(:,:,n) / real(nslyr,kind=dbl_kind) + enddo + call accum_hist_field(n_rsnwn-n2D, iblk, ncat_hist, workb, a3Dc) + endif + endif ! allocated(a3Dc) + + endif ! tr_snow + + end subroutine accum_hist_snow + +!======================================================================= + + end module ice_history_snow + +!======================================================================= diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index e3da6390b..f2dff2367 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -85,7 +85,9 @@ subroutine init_transport integer (kind=int_kind) :: ntrcr, nt_Tsfc, nt_qice, nt_qsno, & nt_sice, nt_fbri, nt_iage, nt_FY, nt_alvl, nt_vlvl, & - nt_apnd, nt_hpnd, nt_ipnd, nt_fsd, nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S + nt_apnd, nt_hpnd, nt_ipnd, nt_fsd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S character(len=*), parameter :: subname = '(init_transport)' @@ -94,9 +96,12 @@ subroutine init_transport call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fbri_out=nt_fbri, & - nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_alvl_out=nt_alvl, nt_fsd_out=nt_fsd, & - nt_vlvl_out=nt_vlvl, nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & - nt_ipnd_out=nt_ipnd, nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S, & + nt_iage_out=nt_iage, nt_FY_out=nt_FY, nt_fsd_out=nt_fsd, & + 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_smice_out=nt_smice, nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, & + nt_rsnw_out=nt_rsnw, & + nt_bgc_Nit_out=nt_bgc_Nit, nt_bgc_S_out=nt_bgc_S, & 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, & @@ -195,6 +200,18 @@ subroutine init_transport if (nt-k==nt_ipnd) & write(nu_diag,1000) 'nt_ipnd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) + if (nt-k==nt_smice) & + write(nu_diag,1000) 'nt_smice ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_smliq) & + write(nu_diag,1000) 'nt_smliq ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rhos) & + write(nu_diag,1000) 'nt_rhos ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_rsnw) & + write(nu_diag,1000) 'nt_rsnw ',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) if (nt-k==nt_fsd) & write(nu_diag,1000) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index bcc7305ff..23fb9df63 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -218,6 +218,7 @@ module ice_flux fresh , & ! fresh water flux to ocean (kg/m^2/s) fsalt , & ! salt flux to ocean (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) + fsloss , & ! rate of snow loss to leads (kg/m^2/s) fswthru , & ! shortwave penetrating to ocean (W/m^2) fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) @@ -294,6 +295,10 @@ module ice_flux fsensn, & ! category sensible heat flux flatn ! category latent heat flux + real (kind=dbl_kind), & + dimension (:,:,:,:), allocatable, public :: & + snwcnt ! counter for presence of snow + ! As above but these remain grid box mean values i.e. they are not ! divided by aice at end of ice_dynamics. These are used in ! CICE_IN_NEMO for coupling and also for generating @@ -448,6 +453,7 @@ subroutine alloc_flux fresh (nx_block,ny_block,max_blocks), & ! fresh water flux to ocean (kg/m^2/s) fsalt (nx_block,ny_block,max_blocks), & ! salt flux to ocean (kg/m^2/s) fhocn (nx_block,ny_block,max_blocks), & ! net heat flux to ocean (W/m^2) + fsloss (nx_block,ny_block,max_blocks), & ! rate of snow loss to leads (kg/m^2/s) fswthru (nx_block,ny_block,max_blocks), & ! shortwave penetrating to ocean (W/m^2) fswthru_vdr (nx_block,ny_block,max_blocks), & ! vis dir shortwave penetrating to ocean (W/m^2) fswthru_vdf (nx_block,ny_block,max_blocks), & ! vis dif shortwave penetrating to ocean (W/m^2) @@ -525,6 +531,7 @@ subroutine alloc_flux fsensn (nx_block,ny_block,ncat,max_blocks), & ! category sensible heat flux flatn (nx_block,ny_block,ncat,max_blocks), & ! category latent heat flux albcnt (nx_block,ny_block,max_blocks,max_nstrm), & ! counter for zenith angle + snwcnt (nx_block,ny_block,max_blocks,max_nstrm), & ! counter for snow salinz (nx_block,ny_block,nilyr+1,max_blocks), & ! initial salinity profile (ppt) Tmltz (nx_block,ny_block,nilyr+1,max_blocks), & ! initial melting temperature (^oC) stat=ierr) diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index a71e6dd17..84bf1d461 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -41,7 +41,7 @@ module ice_forcing field_type_vector, field_loc_NEcorner use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_sea_freezing_temperature - use icepack_intfc, only: icepack_init_wave + use icepack_intfc, only: icepack_init_wave, icepack_init_parameters use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_parameters implicit none @@ -50,7 +50,8 @@ module ice_forcing get_forcing_atmo, get_forcing_ocn, get_wave_spec, & read_clim_data, read_clim_data_nc, & interpolate_data, interp_coeff_monthly, & - read_data_nc_point, interp_coeff + read_data_nc_point, interp_coeff, & + init_snowtable integer (kind=int_kind), public :: & ycycle , & ! number of years in forcing cycle, set by namelist @@ -166,6 +167,16 @@ module ice_forcing integer (kind=int_kind), public :: & Njday_atm ! Number of atm forcing timesteps + character (len=char_len_long), public :: & + snw_filename ! filename for snow lookup table + + character (char_len), public :: & + snw_rhos_fname , & ! snow table 1d rhos field name + snw_Tgrd_fname , & ! snow table 1d Tgrd field name + snw_T_fname , & ! snow table 1d T field name + snw_tau_fname , & ! snow table 3d tau field name + snw_kappa_fname, & ! snow table 3d kappa field name + snw_drdt0_fname ! snow table 3d drdt0 field name ! PRIVATE: @@ -5398,7 +5409,199 @@ end subroutine get_wave_spec !======================================================================= - end module ice_forcing +! initial snow aging lookup table +! +! Dry snow metamorphism table +! snicar_drdt_bst_fit_60_c070416.nc +! Flanner (file metadata units mislabelled) +! drdsdt0 (10^-6 m/hr) tau (10^-6 m) +! + subroutine init_snowtable + + use ice_broadcast, only: broadcast_array, broadcast_scalar + integer (kind=int_kind) :: & + idx_T_max , & ! Table dimensions + idx_rhos_max, & + idx_Tgrd_max + real (kind=dbl_kind), allocatable :: & + snowage_rhos (:), & + snowage_Tgrd (:), & + snowage_T (:), & + snowage_tau (:,:,:), & + snowage_kappa(:,:,:), & + snowage_drdt0(:,:,:) + + ! local variables + + logical (kind=log_kind) :: diag = .false. + + integer (kind=int_kind) :: & + fid ! file id for netCDF file + + character (char_len) :: & + snw_aging_table, & ! aging table setting + fieldname ! field name in netcdf file + + integer (kind=int_kind) :: & + j, k ! indices + + character(len=*), parameter :: subname = '(init_snowtable)' + + !----------------------------------------------------------------- + ! read table of snow aging parameters + !----------------------------------------------------------------- + + call icepack_query_parameters(snw_aging_table_out=snw_aging_table, & + isnw_rhos_out=idx_rhos_max, isnw_Tgrd_out=idx_Tgrd_max, isnw_T_out=idx_T_max) + + if (my_task == master_task) then + write (nu_diag,*) ' ' + write (nu_diag,*) 'Snow aging file:', trim(snw_filename) + endif + + if (snw_aging_table == 'snicar') then + ! just read the 3d data and pass it in + + call ice_open_nc(snw_filename,fid) + + allocate(snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + + fieldname = trim(snw_tau_fname) + call ice_read_nc(fid,fieldname,snowage_tau, diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_kappa_fname) + call ice_read_nc(fid,fieldname,snowage_kappa,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_drdt0_fname) + call ice_read_nc(fid,fieldname,snowage_drdt0,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + + call ice_close_nc(fid) + + call broadcast_array(snowage_tau , master_task) + call broadcast_array(snowage_kappa, master_task) + call broadcast_array(snowage_drdt0, master_task) + + if (my_task == master_task) then + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,' Successfully read snow aging properties:' + write(nu_diag,*) subname,' snw_aging_table = ',trim(snw_aging_table) + write(nu_diag,*) subname,' idx_rhos_max = ',idx_rhos_max + write(nu_diag,*) subname,' idx_Tgrd_max = ',idx_Tgrd_max + write(nu_diag,*) subname,' idx_T_max = ',idx_T_max + write(nu_diag,*) subname,' Data at rhos, Tgrd, T at first index ' + write(nu_diag,*) subname,' snoage_tau (1,1,1) = ',snowage_tau (1,1,1) + write(nu_diag,*) subname,' snoage_kappa (1,1,1) = ',snowage_kappa(1,1,1) + write(nu_diag,*) subname,' snoage_drdt0 (1,1,1) = ',snowage_drdt0(1,1,1) + write(nu_diag,*) subname,' Data at rhos, Tgrd, T at max index' + write(nu_diag,*) subname,' snoage_tau (max,max,max) = ',snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_kappa (max,max,max) = ',snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_drdt0 (max,max,max) = ',snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max) + endif + + call icepack_init_parameters( & + snowage_tau_in = snowage_tau, & + snowage_kappa_in = snowage_kappa, & + snowage_drdt0_in = snowage_drdt0 ) + + deallocate(snowage_tau) + deallocate(snowage_kappa) + deallocate(snowage_drdt0) + + else + ! read everything and pass it in + + call ice_open_nc(snw_filename,fid) + + fieldname = trim(snw_rhos_fname) + call ice_get_ncvarsize(fid,fieldname,idx_rhos_max) + fieldname = trim(snw_Tgrd_fname) + call ice_get_ncvarsize(fid,fieldname,idx_Tgrd_max) + fieldname = trim(snw_T_fname) + call ice_get_ncvarsize(fid,fieldname,idx_T_max) + + call broadcast_scalar(idx_rhos_max, master_task) + call broadcast_scalar(idx_Tgrd_max, master_task) + call broadcast_scalar(idx_T_max , master_task) + + allocate(snowage_rhos (idx_rhos_max)) + allocate(snowage_Tgrd (idx_Tgrd_max)) + allocate(snowage_T (idx_T_max)) + allocate(snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + allocate(snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max)) + + fieldname = trim(snw_rhos_fname) + call ice_read_nc(fid,fieldname,snowage_rhos, diag, & + idx_rhos_max) + fieldname = trim(snw_Tgrd_fname) + call ice_read_nc(fid,fieldname,snowage_Tgrd, diag, & + idx_Tgrd_max) + fieldname = trim(snw_T_fname) + call ice_read_nc(fid,fieldname,snowage_T, diag, & + idx_T_max) + + fieldname = trim(snw_tau_fname) + call ice_read_nc(fid,fieldname,snowage_tau, diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_kappa_fname) + call ice_read_nc(fid,fieldname,snowage_kappa,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + fieldname = trim(snw_drdt0_fname) + call ice_read_nc(fid,fieldname,snowage_drdt0,diag, & + idx_rhos_max,idx_Tgrd_max,idx_T_max) + + call ice_close_nc(fid) + + call broadcast_array(snowage_rhos , master_task) + call broadcast_array(snowage_Tgrd , master_task) + call broadcast_array(snowage_T , master_task) + call broadcast_array(snowage_tau , master_task) + call broadcast_array(snowage_kappa, master_task) + call broadcast_array(snowage_drdt0, master_task) + + if (my_task == master_task) then + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,' Successfully read snow aging properties:' + write(nu_diag,*) subname,' idx_rhos_max = ',idx_rhos_max + write(nu_diag,*) subname,' idx_Tgrd_max = ',idx_Tgrd_max + write(nu_diag,*) subname,' idx_T_max = ',idx_T_max + write(nu_diag,*) subname,' Data at rhos, Tgrd, T = ',snowage_rhos(1),snowage_Tgrd(1),snowage_T(1) + write(nu_diag,*) subname,' snoage_tau (1,1,1) = ',snowage_tau (1,1,1) + write(nu_diag,*) subname,' snoage_kappa (1,1,1) = ',snowage_kappa(1,1,1) + write(nu_diag,*) subname,' snoage_drdt0 (1,1,1) = ',snowage_drdt0(1,1,1) + write(nu_diag,*) subname,' Data at rhos, Tgrd, T = ',snowage_rhos(idx_rhos_max),snowage_Tgrd(idx_Tgrd_max),snowage_T(idx_T_max) + write(nu_diag,*) subname,' snoage_tau (max,max,max) = ',snowage_tau (idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_kappa (max,max,max) = ',snowage_kappa(idx_rhos_max, idx_Tgrd_max, idx_T_max) + write(nu_diag,*) subname,' snoage_drdt0 (max,max,max) = ',snowage_drdt0(idx_rhos_max, idx_Tgrd_max, idx_T_max) + endif + + call icepack_init_parameters( & + isnw_t_in = idx_T_max, & + isnw_Tgrd_in = idx_Tgrd_max, & + isnw_rhos_in = idx_rhos_max, & + snowage_rhos_in = snowage_rhos, & + snowage_Tgrd_in = snowage_Tgrd, & + snowage_T_in = snowage_T, & + snowage_tau_in = snowage_tau, & + snowage_kappa_in = snowage_kappa, & + snowage_drdt0_in = snowage_drdt0 ) + + deallocate(snowage_rhos) + deallocate(snowage_Tgrd) + deallocate(snowage_T) + deallocate(snowage_tau) + deallocate(snowage_kappa) + deallocate(snowage_drdt0) + + endif + + end subroutine init_snowtable !======================================================================= + end module ice_forcing + +!======================================================================= diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index c0c089ac8..a96b30d98 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -74,7 +74,7 @@ subroutine input_data use ice_arrays_column, only: oceanmixed_ice use ice_restart_column, only: restart_age, restart_FY, restart_lvl, & restart_pond_cesm, restart_pond_lvl, restart_pond_topo, restart_aero, & - restart_fsd, restart_iso + restart_fsd, restart_iso, restart_snow use ice_restart_shared, only: & restart, restart_ext, restart_coszen, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 @@ -91,7 +91,10 @@ subroutine input_data bgc_data_type, & ocn_data_type, ocn_data_dir, wave_spec_file, & oceanmixed_file, restore_ocn, trestore, & - ice_data_type + ice_data_type, & + snw_filename, & + snw_tau_fname, snw_kappa_fname, snw_drdt0_fname, & + snw_rhos_fname, snw_Tgrd_fname, snw_T_fname use ice_arrays_column, only: bgc_data_dir, fe_data_type use ice_grid, only: grid_file, gridcpl_file, kmt_file, & bathymetry_file, use_bathymetry, & @@ -129,19 +132,21 @@ subroutine input_data mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & - sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf, iceruf_ocn + sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf, iceruf_ocn, & + rsnw_fall, rsnw_tmax, rhosnew, rhosmin, rhosmax, & + windmin, drhosdwind, snwlvlfac integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound, ktransport character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & - tfrz_option, frzpnd, atmbndy, wave_spec_type + tfrz_option, frzpnd, atmbndy, wave_spec_type, snwredist, snw_aging_table logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & - sw_redist, calc_dragio + sw_redist, calc_dragio, use_smliq_pnd, snwgrain logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond - logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd, tr_snow logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo integer (kind=int_kind) :: numin, numax ! unit number limits @@ -188,6 +193,7 @@ subroutine input_data tr_pond_cesm, restart_pond_cesm, & tr_pond_lvl, restart_pond_lvl, & tr_pond_topo, restart_pond_topo, & + tr_snow, restart_snow, & tr_iso, restart_iso, & tr_aero, restart_aero, & tr_fsd, restart_fsd, & @@ -228,6 +234,13 @@ subroutine input_data rfracmin, rfracmax, pndaspect, hs1, & hp1 + namelist /snow_nml/ & + snwredist, snwgrain, rsnw_fall, rsnw_tmax, & + rhosnew, rhosmin, rhosmax, snwlvlfac, & + windmin, drhosdwind, use_smliq_pnd, snw_aging_table,& + snw_filename, snw_rhos_fname, snw_Tgrd_fname,snw_T_fname, & + snw_tau_fname, snw_kappa_fname, snw_drdt0_fname + namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & highfreq, natmiter, atmiter_conv, calc_dragio, & @@ -411,6 +424,25 @@ subroutine input_data rfracmin = 0.15_dbl_kind ! minimum retained fraction of meltwater rfracmax = 0.85_dbl_kind ! maximum retained fraction of meltwater pndaspect = 0.8_dbl_kind ! ratio of pond depth to area fraction + snwredist = 'none' ! type of snow redistribution + snw_aging_table = 'test' ! snow aging lookup table + snw_filename = 'unknown' ! snowtable filename + snw_tau_fname = 'unknown' ! snowtable file tau fieldname + snw_kappa_fname = 'unknown' ! snowtable file kappa fieldname + snw_drdt0_fname = 'unknown' ! snowtable file drdt0 fieldname + snw_rhos_fname = 'unknown' ! snowtable file rhos fieldname + snw_Tgrd_fname = 'unknown' ! snowtable file Tgrd fieldname + snw_T_fname = 'unknown' ! snowtable file T fieldname + snwgrain = .false. ! snow metamorphosis + use_smliq_pnd = .false. ! use liquid in snow for ponds + rsnw_fall = 100.0_dbl_kind ! radius of new snow (10^-6 m) ! advanced snow physics: 54.526 x 10^-6 m + rsnw_tmax = 1500.0_dbl_kind ! maximum snow radius (10^-6 m) + rhosnew = 100.0_dbl_kind ! new snow density (kg/m^3) + rhosmin = 100.0_dbl_kind ! minimum snow density (kg/m^3) + rhosmax = 450.0_dbl_kind ! maximum snow density (kg/m^3) + windmin = 10.0_dbl_kind ! minimum wind speed to compact snow (m/s) + drhosdwind= 27.3_dbl_kind ! wind compaction factor for snow (kg s/m^4) + snwlvlfac = 0.3_dbl_kind ! fractional increase in snow depth for bulk redistribution albicev = 0.78_dbl_kind ! visible ice albedo for h > ahmax albicei = 0.36_dbl_kind ! near-ir ice albedo for h > ahmax albsnowv = 0.98_dbl_kind ! cold snow albedo, visible @@ -474,6 +506,8 @@ subroutine input_data restart_pond_lvl = .false. ! melt ponds restart tr_pond_topo = .false. ! explicit melt ponds (topographic) restart_pond_topo = .false. ! melt ponds restart + tr_snow = .false. ! advanced snow physics + restart_snow = .false. ! advanced snow physics restart tr_iso = .false. ! isotopes restart_iso = .false. ! isotopes restart tr_aero = .false. ! aerosols @@ -547,6 +581,9 @@ subroutine input_data print*,'Reading ponds_nml' read(nu_nml, nml=ponds_nml,iostat=nml_error) if (nml_error /= 0) exit + print*,'Reading snow_nml' + read(nu_nml, nml=snow_nml,iostat=nml_error) + if (nml_error /= 0) exit print*,'Reading forcing_nml' read(nu_nml, nml=forcing_nml,iostat=nml_error) if (nml_error /= 0) exit @@ -737,6 +774,25 @@ subroutine input_data call broadcast_scalar(rfracmin, master_task) call broadcast_scalar(rfracmax, master_task) call broadcast_scalar(pndaspect, master_task) + call broadcast_scalar(snwredist, master_task) + call broadcast_scalar(snw_aging_table, master_task) + call broadcast_scalar(snw_filename, master_task) + call broadcast_scalar(snw_tau_fname, master_task) + call broadcast_scalar(snw_kappa_fname, master_task) + call broadcast_scalar(snw_drdt0_fname, master_task) + call broadcast_scalar(snw_rhos_fname, master_task) + call broadcast_scalar(snw_Tgrd_fname, master_task) + call broadcast_scalar(snw_T_fname, master_task) + call broadcast_scalar(snwgrain, master_task) + call broadcast_scalar(use_smliq_pnd, master_task) + call broadcast_scalar(rsnw_fall, master_task) + call broadcast_scalar(rsnw_tmax, master_task) + call broadcast_scalar(rhosnew, master_task) + call broadcast_scalar(rhosmin, master_task) + call broadcast_scalar(rhosmax, master_task) + call broadcast_scalar(windmin, master_task) + call broadcast_scalar(drhosdwind, master_task) + call broadcast_scalar(snwlvlfac, master_task) call broadcast_scalar(albicev, master_task) call broadcast_scalar(albicei, master_task) call broadcast_scalar(albsnowv, master_task) @@ -800,6 +856,8 @@ subroutine input_data call broadcast_scalar(restart_pond_lvl, master_task) call broadcast_scalar(tr_pond_topo, master_task) call broadcast_scalar(restart_pond_topo, master_task) + call broadcast_scalar(tr_snow, master_task) + call broadcast_scalar(restart_snow, master_task) call broadcast_scalar(tr_iso, master_task) call broadcast_scalar(restart_iso, master_task) call broadcast_scalar(tr_aero, master_task) @@ -880,6 +938,7 @@ subroutine input_data restart_pond_cesm = .false. restart_pond_lvl = .false. restart_pond_topo = .false. + restart_snow = .false. ! tcraig, OK to leave as true, needed for boxrestore case ! restart_ext = .false. else @@ -988,6 +1047,59 @@ subroutine input_data abort_list = trim(abort_list)//":8" endif + if (snwredist(1:4) /= 'none' .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist on but tr_snow=F' + write (nu_diag,*) 'ERROR: Use tr_snow=T for snow redistribution' + endif + abort_list = trim(abort_list)//":37" + endif + if (snwredist(1:4) == 'bulk' .and. .not. tr_lvl) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist=bulk but tr_lvl=F' + write (nu_diag,*) 'ERROR: Use tr_lvl=T for snow redistribution' + endif + abort_list = trim(abort_list)//":38" + endif + if (snwredist(1:6) == 'ITDrdg' .and. .not. tr_lvl) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwredist=ITDrdg but tr_lvl=F' + write (nu_diag,*) 'ERROR: Use tr_lvl=T for snow redistribution' + endif + abort_list = trim(abort_list)//":39" + endif + if (use_smliq_pnd .and. .not. snwgrain) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: use_smliq_pnd = T but' + write (nu_diag,*) 'ERROR: snow metamorphosis not used' + write (nu_diag,*) 'ERROR: Use snwgrain=T with smliq for ponds' + endif + abort_list = trim(abort_list)//":40" + endif + if (use_smliq_pnd .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: use_smliq_pnd = T but' + write (nu_diag,*) 'ERROR: snow tracers are not active' + write (nu_diag,*) 'ERROR: Use tr_snow=T with smliq for ponds' + endif + abort_list = trim(abort_list)//":41" + endif + if (snwgrain .and. .not. tr_snow) then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: snwgrain=T but tr_snow=F' + write (nu_diag,*) 'ERROR: Use tr_snow=T for snow metamorphosis' + endif + abort_list = trim(abort_list)//":42" + endif + if (trim(snw_aging_table) /= 'test' .and. & + trim(snw_aging_table) /= 'snicar' .and. & + trim(snw_aging_table) /= 'file') then + if (my_task == master_task) then + write (nu_diag,*) 'ERROR: unknown snw_aging_table = '//trim(snw_aging_table) + endif + abort_list = trim(abort_list)//":43" + endif + if (tr_iso .and. n_iso==0) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: isotopes activated but' @@ -1017,7 +1129,7 @@ subroutine input_data if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: nilyr < 1' endif - abort_list = trim(abort_list)//":33" + abort_list = trim(abort_list)//":2" endif if (nslyr < 1) then @@ -1051,6 +1163,13 @@ subroutine input_data abort_list = trim(abort_list)//":10" endif + if (trim(shortwave) /= 'dEdd' .and. snwgrain) then + if (my_task == master_task) then + write (nu_diag,*) 'WARNING: snow grain radius activated but' + write (nu_diag,*) 'WARNING: dEdd shortwave is not.' + endif + endif + if ((rfracmin < -puny .or. rfracmin > c1+puny) .or. & (rfracmax < -puny .or. rfracmax > c1+puny) .or. & (rfracmin > rfracmax)) then @@ -1655,6 +1774,78 @@ subroutine input_data write(nu_diag,1002) ' rfracmin = ', rfracmin,' : minimum fraction of melt water added to ponds' write(nu_diag,1002) ' rfracmax = ', rfracmax,' : maximum fraction of melt water added to ponds' + write(nu_diag,*) ' ' + write(nu_diag,*) ' Snow redistribution/metamorphism tracers' + write(nu_diag,*) '-----------------------------------------' + if (tr_snow) then + write(nu_diag,1010) ' tr_snow = ', tr_snow, & + ' : advanced snow physics' + if (snwredist(1:4) == 'none') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Snow redistribution scheme turned off' + else + if (snwredist(1:4) == 'bulk') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Using bulk snow redistribution scheme' + elseif (snwredist(1:6) == 'ITDrdg') then + write(nu_diag,1030) ' snwredist = ', trim(snwredist), & + ' : Using ridging based snow redistribution scheme' + write(nu_diag,1002) ' rhosnew = ', rhosnew, & + ' : new snow density (kg/m^3)' + write(nu_diag,1002) ' rhosmin = ', rhosmin, & + ' : minimum snow density (kg/m^3)' + write(nu_diag,1002) ' rhosmax = ', rhosmax, & + ' : maximum snow density (kg/m^3)' + write(nu_diag,1002) ' windmin = ', windmin, & + ' : minimum wind speed to compact snow (m/s)' + write(nu_diag,1002) ' drhosdwind = ', drhosdwind, & + ' : wind compaction factor (kg s/m^4)' + endif + write(nu_diag,1002) ' snwlvlfac = ', snwlvlfac, & + ' : fractional increase in snow depth for redistribution on ridges' + endif + if (.not. snwgrain) then + write(nu_diag,1010) ' snwgrain = ', snwgrain, & + ' : Snow metamorphosis turned off' + else + write(nu_diag,1010) ' snwgrain = ', snwgrain, & + ' : Using snow metamorphosis scheme' + write(nu_diag,1002) ' rsnw_tmax = ', rsnw_tmax, & + ' : maximum snow radius (10^-6 m)' + endif + write(nu_diag,1002) ' rsnw_fall = ', rsnw_fall, & + ' : radius of new snow (10^-6 m)' + if (snwgrain) then + if (use_smliq_pnd) then + tmpstr2 = ' : Using liquid water in snow for melt ponds' + else + tmpstr2 = ' : NOT using liquid water in snow for melt ponds' + endif + write(nu_diag,1010) ' use_smliq_pnd = ', use_smliq_pnd, trim(tmpstr2) + if (snw_aging_table == 'test') then + tmpstr2 = ' : Using 5x5x1 test matrix of internallly defined snow aging parameters' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + elseif (snw_aging_table == 'snicar') then + tmpstr2 = ' : Reading 3D snow aging parameters from SNICAR file' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + write(nu_diag,1031) ' snw_filename = ',trim(snw_filename) + write(nu_diag,1031) ' snw_tau_fname = ',trim(snw_tau_fname) + write(nu_diag,1031) ' snw_kappa_fname = ',trim(snw_kappa_fname) + write(nu_diag,1031) ' snw_drdt0_fname = ',trim(snw_drdt0_fname) + elseif (snw_aging_table == 'file') then + tmpstr2 = ' : Reading 1D and 3D snow aging dimensions and parameters from external file' + write(nu_diag,1030) ' snw_aging_table = ', trim(snw_aging_table),trim(tmpstr2) + write(nu_diag,1031) ' snw_filename = ',trim(snw_filename) + write(nu_diag,1031) ' snw_rhos_fname = ',trim(snw_rhos_fname) + write(nu_diag,1031) ' snw_Tgrd_fname = ',trim(snw_Tgrd_fname) + write(nu_diag,1031) ' snw_T_fname = ',trim(snw_T_fname) + write(nu_diag,1031) ' snw_tau_fname = ',trim(snw_tau_fname) + write(nu_diag,1031) ' snw_kappa_fname = ',trim(snw_kappa_fname) + write(nu_diag,1031) ' snw_drdt0_fname = ',trim(snw_drdt0_fname) + endif + endif + endif + write(nu_diag,*) ' ' write(nu_diag,*) ' Primary state variables, tracers' write(nu_diag,*) ' (excluding biogeochemistry)' @@ -1668,6 +1859,7 @@ subroutine input_data if (tr_pond_lvl) write(nu_diag,1010) ' tr_pond_lvl = ', tr_pond_lvl,' : level-ice pond formulation' if (tr_pond_topo) write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo,' : topo pond formulation' if (tr_pond_cesm) write(nu_diag,1010) ' tr_pond_cesm = ', tr_pond_cesm,' : CESM pond formulation' + if (tr_snow) write(nu_diag,1010) ' tr_snow = ', tr_snow,' : advanced snow physics' if (tr_iage) write(nu_diag,1010) ' tr_iage = ', tr_iage,' : chronological ice age' if (tr_FY) write(nu_diag,1010) ' tr_FY = ', tr_FY,' : first-year ice area' if (tr_iso) write(nu_diag,1010) ' tr_iso = ', tr_iso,' : diagnostic isotope tracers' @@ -1789,6 +1981,7 @@ subroutine input_data write(nu_diag,1011) ' restart_pond_cesm= ', restart_pond_cesm write(nu_diag,1011) ' restart_pond_lvl = ', restart_pond_lvl write(nu_diag,1011) ' restart_pond_topo= ', restart_pond_topo + write(nu_diag,1011) ' restart_snow = ', restart_snow write(nu_diag,1011) ' restart_iso = ', restart_iso write(nu_diag,1011) ' restart_aero = ', restart_aero write(nu_diag,1011) ' restart_fsd = ', restart_fsd @@ -1853,10 +2046,14 @@ subroutine input_data wave_spec_in=wave_spec, nfreq_in=nfreq, & tfrz_option_in=tfrz_option, kalg_in=kalg, fbot_xfer_type_in=fbot_xfer_type, & Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, iceruf_ocn_in=iceruf_ocn, calc_dragio_in=calc_dragio, & + windmin_in=windmin, drhosdwind_in=drhosdwind, & + rsnw_fall_in=rsnw_fall, rsnw_tmax_in=rsnw_tmax, rhosnew_in=rhosnew, & + snwlvlfac_in=snwlvlfac, rhosmin_in=rhosmin, rhosmax_in=rhosmax, & + snwredist_in=snwredist, snwgrain_in=snwgrain, snw_aging_table_in=trim(snw_aging_table), & sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp) call icepack_init_tracer_flags(tr_iage_in=tr_iage, tr_FY_in=tr_FY, & tr_lvl_in=tr_lvl, tr_iso_in=tr_iso, tr_aero_in=tr_aero, & - tr_fsd_in=tr_fsd, tr_pond_in=tr_pond, & + tr_fsd_in=tr_fsd, tr_snow_in=tr_snow, tr_pond_in=tr_pond, & tr_pond_cesm_in=tr_pond_cesm, tr_pond_lvl_in=tr_pond_lvl, tr_pond_topo_in=tr_pond_topo) call icepack_init_tracer_sizes(ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & nfsd_in=nfsd, n_algae_in=n_algae, n_iso_in=n_iso, n_aero_in=n_aero, & @@ -1913,10 +2110,12 @@ subroutine init_state heat_capacity ! from icepack integer (kind=int_kind) :: ntrcr - logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo + logical (kind=log_kind) :: tr_snow, tr_fsd 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 + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw integer (kind=int_kind) :: nt_isosno, nt_isoice, nt_aero, nt_fsd type (block) :: & @@ -1929,12 +2128,15 @@ subroutine init_state call icepack_query_parameters(heat_capacity_out=heat_capacity) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_fsd_out=tr_fsd, & - tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + tr_lvl_out=tr_lvl, tr_iso_out=tr_iso, tr_aero_out=tr_aero, & + tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo, & + tr_snow_out=tr_snow, tr_fsd_out=tr_fsd) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_sice_out=nt_sice, & nt_qice_out=nt_qice, nt_qsno_out=nt_qsno, nt_iage_out=nt_iage, nt_fy_out=nt_fy, & 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_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) @@ -2011,6 +2213,14 @@ subroutine init_state trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth trcr_depend(nt_ipnd) = 2+nt_apnd ! refrozen pond lid endif + if (tr_snow) then ! snow-volume-weighted snow tracers + do k = 1, nslyr + trcr_depend(nt_smice + k - 1) = 2 ! ice mass in snow + trcr_depend(nt_smliq + k - 1) = 2 ! liquid mass in snow + trcr_depend(nt_rhos + k - 1) = 2 ! effective snow density + trcr_depend(nt_rsnw + k - 1) = 2 ! snow radius + enddo + endif if (tr_fsd) then do it = 1, nfsd trcr_depend(nt_fsd + it - 1) = 0 ! area-weighted floe size distribution @@ -2241,7 +2451,7 @@ subroutine set_state_var (nx_block, ny_block, & indxi, indxj ! compressed indices for cells with aicen > puny real (kind=dbl_kind) :: & - Tsfc, sum, hbar, puny, rhos, Lfresh, rad_to_deg + Tsfc, sum, hbar, puny, rhos, Lfresh, rad_to_deg, rsnw_fall real (kind=dbl_kind), dimension(ncat) :: & ainit, hinit ! initial area, thickness @@ -2257,22 +2467,26 @@ subroutine set_state_var (nx_block, ny_block, & edge_init_nh = 70._dbl_kind, & ! initial ice edge, N.Hem. (deg) edge_init_sh = -60._dbl_kind ! initial ice edge, S.Hem. (deg) - logical (kind=log_kind) :: tr_brine, tr_lvl + logical (kind=log_kind) :: tr_brine, tr_lvl, tr_snow integer (kind=int_kind) :: ntrcr integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw character(len=*), parameter :: subname='(set_state_var)' !----------------------------------------------------------------- call icepack_query_tracer_sizes(ntrcr_out=ntrcr) - call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl) + call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & + tr_snow_out=tr_snow) call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, & - nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) + nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw) call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny, & - rad_to_deg_out=rad_to_deg) + rad_to_deg_out=rad_to_deg, rsnw_fall_out=rsnw_fall) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -2304,6 +2518,14 @@ subroutine set_state_var (nx_block, ny_block, & do k = 1, nslyr trcrn(i,j,nt_qsno+k-1,n) = -rhos * Lfresh enddo + if (tr_snow) then + do k = 1, nslyr + trcrn(i,j,nt_rsnw +k-1,n) = rsnw_fall + trcrn(i,j,nt_rhos +k-1,n) = rhos + trcrn(i,j,nt_smice+k-1,n) = rhos + trcrn(i,j,nt_smliq+k-1,n) = c0 + enddo ! nslyr + endif enddo enddo enddo diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index d65cf52d3..976e95361 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -36,7 +36,7 @@ module ice_step_mod private public :: step_therm1, step_therm2, step_dyn_horiz, step_dyn_ridge, & - prep_radiation, step_radiation, ocean_mixed_layer, & + step_snow, prep_radiation, step_radiation, ocean_mixed_layer, & update_state, biogeochemistry, save_init, step_dyn_wave !======================================================================= @@ -163,7 +163,7 @@ subroutine step_therm1 (dt, iblk) 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, & + fswsfcn, fswintn, Sswabsn, Iswabsn, meltsliqn, meltsliq, & fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: yday @@ -172,13 +172,13 @@ subroutine step_therm1 (dt, iblk) use ice_flux, only: frzmlt, sst, Tf, strocnxT, strocnyT, rside, fbot, Tbot, Tsnice, & meltsn, melttn, meltbn, congeln, snoicen, uatm, vatm, fside, & wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & - flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & + 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 + 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 @@ -211,11 +211,11 @@ subroutine step_therm1 (dt, iblk) 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_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_cesm, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq, tr_snow real (kind=dbl_kind) :: & uvel_center, & ! cell-centered velocity, x component (m/s) @@ -228,6 +228,9 @@ subroutine step_therm1 (dt, iblk) 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 @@ -240,13 +243,15 @@ subroutine step_therm1 (dt, iblk) 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_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + 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, & @@ -256,7 +261,9 @@ subroutine step_therm1 (dt, iblk) prescribed_ice = .false. #endif - isosno (:,:) = c0 + rsnwn (:,:) = c0 + smicen (:,:) = c0 + smliqn (:,:) = c0 isoice (:,:) = c0 aerosno(:,:,:) = c0 aeroice(:,:,:) = c0 @@ -302,6 +309,16 @@ subroutine step_therm1 (dt, iblk) vvel_center = c0 endif ! highfreq + 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 @@ -350,6 +367,9 @@ subroutine step_therm1 (dt, iblk) ipnd = trcrn (i,j,nt_ipnd,:,iblk), & iage = trcrn (i,j,nt_iage,:,iblk), & FY = trcrn (i,j,nt_FY ,:,iblk), & + rsnwn = rsnwn (:,:), & + smicen = smicen (:,:), & + smliqn = smliqn (:,:), & aerosno = aerosno (:,:,:), & aeroice = aeroice (:,:,:), & isosno = isosno (:,:), & @@ -397,13 +417,14 @@ subroutine step_therm1 (dt, iblk) strocnyT = strocnyT (i,j, iblk), & fbot = fbot (i,j, iblk), & Tbot = Tbot (i,j, iblk), & - Tsnice = Tsnice (i,j, iblk), & + Tsnice = Tsnice (i,j, iblk), & frzmlt = frzmlt (i,j, iblk), & rside = rside (i,j, iblk), & fside = fside (i,j, iblk), & fsnow = fsnow (i,j, iblk), & frain = frain (i,j, iblk), & fpond = fpond (i,j, iblk), & + fsloss = fsloss (i,j, iblk), & fsurf = fsurf (i,j, iblk), & fsurfn = fsurfn (i,j,:,iblk), & fcondtop = fcondtop (i,j, iblk), & @@ -433,10 +454,10 @@ subroutine step_therm1 (dt, iblk) fsalt = fsalt (i,j, iblk), & fhocn = fhocn (i,j, iblk), & fswthru = fswthru (i,j, iblk), & - fswthru_vdr = fswthru_vdr (i,j, iblk),& - fswthru_vdf = fswthru_vdf (i,j, iblk),& - fswthru_idr = fswthru_idr (i,j, iblk),& - fswthru_idf = fswthru_idf (i,j, iblk),& + fswthru_vdr = fswthru_vdr (i,j, iblk), & + fswthru_vdf = fswthru_vdf (i,j, iblk), & + fswthru_idr = fswthru_idr (i,j, iblk), & + 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), & @@ -461,7 +482,10 @@ subroutine step_therm1 (dt, iblk) congeln = congeln (i,j,:,iblk), & snoice = snoice (i,j, iblk), & snoicen = snoicen (i,j,:,iblk), & + dsnow = dsnow (i,j, iblk), & dsnown = dsnown (i,j,:,iblk), & + meltsliq = meltsliq (i,j, iblk), & + 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), & @@ -483,6 +507,16 @@ subroutine step_therm1 (dt, iblk) 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) & @@ -685,13 +719,15 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + dt ! time step - real (kind=dbl_kind), dimension(:,:,:), intent(inout) :: & - 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), 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 @@ -747,6 +783,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) n_trcr_strata = n_trcr_strata(:), & nt_strata = nt_strata(:,:)) + if (present(offset)) then + !----------------------------------------------------------------- ! Compute thermodynamic area and volume tendencies. !----------------------------------------------------------------- @@ -762,7 +800,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) dagedt(i,j,iblk) = (trcr(i,j,nt_iage,iblk) & - dagedt(i,j,iblk)) / dt endif - endif + endif ! tr_iage + endif ! present(offset) enddo ! i enddo ! j @@ -1022,6 +1061,118 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) end subroutine step_dyn_ridge +!======================================================================= +! +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine step_snow (dt, iblk) + + use ice_blocks, only: block, get_block + use ice_calendar, only: nstreams + use ice_domain, only: blocks_ice + 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 + n, & ! category index + ns, & ! history streams index + ipoint ! index for print diagnostic + + 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 @@ -1067,7 +1218,7 @@ subroutine step_radiation (dt, iblk) this_block ! block information for current block integer (kind=int_kind) :: & - nt_Tsfc, nt_alvl, & + nt_Tsfc, nt_alvl, nt_rsnw, & nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & ntrcr, nbtrcr, nbtrcr_sw, nt_fbri @@ -1078,13 +1229,14 @@ subroutine step_radiation (dt, iblk) nlt_zaero_sw, nt_zaero logical (kind=log_kind) :: & - tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain real (kind=dbl_kind), dimension(ncat) :: & - fbri ! brine height to ice thickness + fbri ! brine height to ice thickness real(kind= dbl_kind), dimension(:,:), allocatable :: & - ztrcr_sw + 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 @@ -1099,16 +1251,18 @@ subroutine step_radiation (dt, iblk) 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_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) + 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 @@ -1130,10 +1284,16 @@ subroutine step_radiation (dt, iblk) write (nu_diag, *) 'my_task = ',my_task enddo ! ipoint endif - fbri(:) = c0 + fbri (:) = c0 ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + 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 @@ -1182,8 +1342,7 @@ subroutine step_radiation (dt, 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), & - l_print_point=l_print_point) - + rsnow =rsnow (:,:), l_print_point=l_print_point) endif if (dEdd_algae .and. (tr_zaero .or. tr_bgc_N)) then @@ -1202,6 +1361,7 @@ subroutine step_radiation (dt, iblk) file=__FILE__, line=__LINE__) deallocate(ztrcr_sw) + deallocate(rsnow) call ice_timer_stop(timer_sw) ! shortwave diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index d902c62f8..d488b5693 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -68,6 +68,9 @@ module ice_read_write ice_read_nc_xyz, & !ice_read_nc_xyf, & ice_read_nc_point, & + ice_read_nc_1D, & + ice_read_nc_2D, & + ice_read_nc_3D, & ice_read_nc_z end interface @@ -1120,7 +1123,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1293,7 +1296,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1472,7 +1475,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & - dimname ! dimension name + dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -1646,7 +1649,7 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & workg ! temporary work variable character (char_len) :: & - dimname ! dimension name + dimname ! dimension name if (my_task == master_task) then @@ -1700,6 +1703,277 @@ end subroutine ice_read_nc_point !======================================================================= +! Written by T. Craig + + subroutine ice_read_nc_1D(fid, varname, work, diag, & + xdim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_1D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1/), & + count=(/xdim/) ) + work(1:xdim) = workg(1:xdim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_1D + +!======================================================================= + +! Written by T. Craig + + subroutine ice_read_nc_2D(fid, varname, work, diag, & + xdim, ydim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim, ydim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:,:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_2D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim,ydim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim .or. & + size(work,dim=2) < ydim) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1,1/), & + count=(/xdim,ydim/) ) + work(1:xdim,1:ydim) = workg(1:xdim, 1:ydim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' ydim= ', ydim, ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_2D + +!======================================================================= +!======================================================================= + +! Written by T. Craig + + subroutine ice_read_nc_3D(fid, varname, work, diag, & + xdim, ydim, zdim) + + use ice_fileunits, only: nu_diag + + integer (kind=int_kind), intent(in) :: & + fid , & ! file id + xdim, ydim,zdim ! field dimensions + + logical (kind=log_kind), intent(in) :: & + diag ! if true, write diagnostic output + + character (char_len), intent(in) :: & + varname ! field name in netcdf file + + real (kind=dbl_kind), dimension(:,:,:), intent(out) :: & + work ! output array + + ! local variables + + character(len=*), parameter :: subname = '(ice_read_nc_3D)' + +#ifdef USE_NETCDF +! netCDF file diagnostics: + integer (kind=int_kind) :: & + varid, & ! netcdf id for field + status, & ! status output from netcdf routines + ndim, nvar, & ! sizes of netcdf file + dimlen ! size of dimension + + character (char_len) :: & + dimname ! dimension name + + real (kind=dbl_kind), dimension(xdim,ydim,zdim) :: & + workg ! output array (real, 8-byte) + + !-------------------------------------------------------------- + + if (my_task == master_task) then + + if (size(work,dim=1) < xdim .or. & + size(work,dim=2) < ydim .or. & + size(work,dim=3) < zdim ) then + write(nu_diag,*) subname,' work, dim=1 ',size(work,dim=1),xdim + write(nu_diag,*) subname,' work, dim=2 ',size(work,dim=2),ydim + write(nu_diag,*) subname,' work, dim=3 ',size(work,dim=3),zdim + call abort_ice (subname//' ERROR: work array wrong size '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + !------------------------------------------------------------- + ! Find out ID of required variable + !------------------------------------------------------------- + + status = nf90_inq_varid(fid, trim(varname), varid) + + if (status /= nf90_noerr) then + call abort_ice (subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__ ) + endif + + !-------------------------------------------------------------- + ! Read array + !-------------------------------------------------------------- + status = nf90_get_var( fid, varid, workg, & + start=(/1,1,1/), & + count=(/xdim,ydim,zdim/) ) + work(1:xdim,1:ydim,1:zdim) = workg(1:xdim, 1:ydim, 1:zdim) + + !------------------------------------------------------------------- + ! optional diagnostics + !------------------------------------------------------------------- + + if (diag) then + write(nu_diag,*) subname, & + ' fid= ',fid, ', xdim = ',xdim, & + ' ydim= ', ydim,' zdim = ',zdim, ' varname = ',trim(varname) + status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) + write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + endif + endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) + work = c0 ! to satisfy intent(out) attribute +#endif + + end subroutine ice_read_nc_3D + +!======================================================================= + ! Adapted by Nicole Jeffery, LANL subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & @@ -1739,7 +2013,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & dimlen ! size of dimension character (char_len) :: & - dimname ! dimension name + dimname ! dimension name #endif character(len=*), parameter :: subname = '(ice_read_nc_z)' @@ -1791,7 +2065,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_z @@ -1841,7 +2115,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1914,7 +2188,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_nc_xy @@ -1965,7 +2239,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2048,7 +2322,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_nc_xyz @@ -2094,7 +2368,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name ! real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2162,7 +2436,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif @@ -2191,7 +2465,7 @@ subroutine ice_close_nc(fid) endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) #endif end subroutine ice_close_nc @@ -2249,7 +2523,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -2328,7 +2602,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2406,7 +2680,7 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif @@ -2452,7 +2726,7 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) endif #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 index 91d57ea48..a6f42a6a5 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 @@ -15,11 +15,12 @@ module ice_restart use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_fileunits, only: nu_dump, nu_dump_eap, nu_dump_FY, nu_dump_age use ice_fileunits, only: nu_dump_lvl, nu_dump_pond, nu_dump_hbrine - use ice_fileunits, only: nu_dump_bgc, nu_dump_aero, nu_dump_fsd, nu_dump_iso + use ice_fileunits, only: nu_dump_iso, nu_dump_snow + use ice_fileunits, only: nu_dump_bgc, nu_dump_aero, nu_dump_fsd use ice_fileunits, only: nu_restart, nu_restart_eap, nu_restart_FY, nu_restart_age use ice_fileunits, only: nu_restart_lvl, nu_restart_pond, nu_restart_hbrine use ice_fileunits, only: nu_restart_bgc, nu_restart_aero, nu_restart_fsd - use ice_fileunits, only: nu_restart_iso + use ice_fileunits, only: nu_restart_iso, nu_restart_snow use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_sizes @@ -57,7 +58,7 @@ subroutine init_restart_read(ice_ic) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow character(len=char_len_long) :: & filename, filename0 @@ -82,7 +83,8 @@ subroutine init_restart_read(ice_ic) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -285,6 +287,26 @@ subroutine init_restart_read(ice_ic) endif endif + if (tr_snow) then + if (my_task == master_task) then + n = index(filename0,trim(restart_file)) + if (n == 0) call abort_ice(subname//'ERROR: snow restart: filename discrepancy') + string1 = trim(filename0(1:n-1)) + string2 = trim(filename0(n+lenstr(restart_file):lenstr(filename0))) + write(filename,'(a,a,a,a)') & + string1(1:lenstr(string1)), & + restart_file(1:lenstr(restart_file)),'.snow', & + string2(1:lenstr(string2)) + if (restart_ext) then + call ice_open_ext(nu_restart_snow,filename,0) + else + call ice_open(nu_restart_snow,filename,0) + endif + read (nu_restart_snow) iignore,rignore,rignore + write(nu_diag,*) 'Reading ',filename(1:lenstr(filename)) + endif + endif + if (tr_brine) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) @@ -392,7 +414,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow integer (kind=int_kind) :: & nbtrcr ! number of bgc tracers @@ -408,7 +430,8 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -599,6 +622,26 @@ subroutine init_restart_write(filename_spec) endif + if (tr_snow) then + + write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & + restart_dir(1:lenstr(restart_dir)), & + restart_file(1:lenstr(restart_file)),'.snow.', & + myear,'-',mmonth,'-',mday,'-',msec + + if (restart_ext) then + call ice_open_ext(nu_dump_snow,filename,0) + else + call ice_open(nu_dump_snow,filename,0) + endif + + if (my_task == master_task) then + write(nu_dump_snow) istep1,timesecs,time_forc + write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) + endif + + endif + if (tr_brine) then write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & @@ -808,7 +851,7 @@ subroutine final_restart() logical (kind=log_kind) :: & solve_zsal, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow integer (kind=int_kind) :: & nbtrcr ! number of bgc tracers @@ -822,7 +865,8 @@ subroutine final_restart() call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine) + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -838,6 +882,7 @@ subroutine final_restart() if (tr_pond_cesm) close(nu_dump_pond) if (tr_pond_lvl) close(nu_dump_pond) if (tr_pond_topo) close(nu_dump_pond) + if (tr_snow) close(nu_dump_snow) if (tr_brine) close(nu_dump_hbrine) if (solve_zsal .or. nbtrcr > 0) & close(nu_dump_bgc) diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index e744caf09..f6002ff40 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -145,7 +145,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & solve_zsal, skl_bgc, z_tracers, tr_fsd, & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & tr_bgc_chl, tr_bgc_Am, & @@ -181,7 +181,8 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_fsd_out=tr_fsd, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & @@ -480,6 +481,16 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'qsno'//trim(nchar),dims) enddo + if (tr_snow) then + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'smice'//trim(nchar),dims) + call define_rest_field(ncid,'smliq'//trim(nchar),dims) + call define_rest_field(ncid, 'rhos'//trim(nchar),dims) + call define_rest_field(ncid, 'rsnw'//trim(nchar),dims) + enddo + endif + if (tr_fsd) then do k=1,nfsd write(nchar,'(i3.3)') k diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 12d5d8e71..c6d6a02af 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -151,7 +151,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & - tr_pond_topo, tr_pond_lvl, tr_brine, & + tr_pond_topo, tr_pond_lvl, tr_brine, tr_snow, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & tr_bgc_chl, tr_bgc_Am, & @@ -187,7 +187,8 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & tr_iso_out=tr_iso, tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, tr_brine_out=tr_brine, & + tr_pond_topo_out=tr_pond_topo, tr_pond_lvl_out=tr_pond_lvl, & + tr_snow_out=tr_snow, tr_brine_out=tr_brine, & tr_bgc_N_out=tr_bgc_N, tr_bgc_C_out=tr_bgc_C, tr_bgc_Nit_out=tr_bgc_Nit, & tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & tr_bgc_chl_out=tr_bgc_chl, tr_bgc_Am_out=tr_bgc_Am, & @@ -483,6 +484,16 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'qsno'//trim(nchar),dims) enddo + if (tr_snow) then + do k=1,nslyr + write(nchar,'(i3.3)') k + call define_rest_field(File,'smice'//trim(nchar),dims) + call define_rest_field(File,'smliq'//trim(nchar),dims) + call define_rest_field(File, 'rhos'//trim(nchar),dims) + call define_rest_field(File, 'rsnw'//trim(nchar),dims) + enddo + endif + if (tr_fsd) then do k=1,nfsd write(nchar,'(i3.3)') k diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 60f71fa8a..363025b9b 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -18,6 +18,7 @@ module CICE_InitMod 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, & @@ -76,7 +77,7 @@ subroutine cice_init 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 + 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 @@ -90,7 +91,8 @@ subroutine cice_init 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_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 @@ -162,7 +164,7 @@ subroutine cice_init 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) + 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__) @@ -176,7 +178,7 @@ subroutine cice_init 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) + 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__) @@ -207,8 +209,20 @@ subroutine cice_init 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) @@ -235,12 +249,12 @@ subroutine init_restart 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 + 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, & + use ice_init_column, only: init_age, init_FY, init_lvl, init_snowtracers, & init_meltponds_cesm, 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, & @@ -248,6 +262,7 @@ subroutine init_restart restart_pond_cesm, read_restart_pond_cesm, & 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, & @@ -262,12 +277,13 @@ subroutine init_restart iblk ! block index logical(kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_pond_cesm, tr_pond_lvl, & - tr_pond_topo, tr_fsd, tr_iso, tr_aero, tr_brine, & + 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)' @@ -282,10 +298,12 @@ subroutine init_restart call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, 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_fsd_out=tr_fsd, tr_iso_out=tr_iso) + 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, & @@ -382,6 +400,22 @@ subroutine init_restart 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. @@ -398,7 +432,7 @@ subroutine init_restart if (restart_iso) then call read_restart_iso else - do iblk = 1, nblocks + 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 diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 08059435f..0fde18e04 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -151,12 +151,13 @@ subroutine ice_step use ice_restart_column, only: write_restart_age, write_restart_FY, & write_restart_lvl, write_restart_pond_cesm, 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_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, save_init, step_dyn_wave + biogeochemistry, save_init, 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 @@ -170,7 +171,7 @@ subroutine ice_step offset ! d(age)/dt time offset logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & + tr_iage, tr_FY, tr_lvl, tr_fsd, tr_snow, & tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec @@ -191,7 +192,7 @@ subroutine ice_step call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_cesm_out=tr_pond_cesm, 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_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__) @@ -317,17 +318,28 @@ subroutine ice_step enddo endif + call ice_timer_start(timer_column) ! column physics + call ice_timer_start(timer_thermo) ! thermodynamics + !----------------------------------------------------------------- - ! albedo, shortwave radiation + ! snow redistribution and metamorphosis !----------------------------------------------------------------- - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics + if (tr_snow) then ! advanced snow physics + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + call update_state (dt) ! clean up + endif !MHRI: CHECK THIS OMP !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks + !----------------------------------------------------------------- + ! albedo, shortwave radiation + !----------------------------------------------------------------- + if (ktherm >= 0) call step_radiation (dt, iblk) if (debug_model) then @@ -383,6 +395,7 @@ subroutine ice_step if (tr_pond_cesm) call write_restart_pond_cesm 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 diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 46ea6f62e..dbad4292c 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -67,6 +67,15 @@ module ice_arrays_column character (len=35), public, allocatable :: c_hi_range(:) + ! icepack_snow.F90 + real (kind=dbl_kind), public, & + dimension (:,:,:), allocatable :: & + meltsliq ! snow melt mass (kg/m^2/step-->kg/m^2/day) + + real (kind=dbl_kind), public, & + dimension (:,:,:,:), allocatable :: & + meltsliqn ! snow melt mass in category n (kg/m^2) + ! icepack_meltpond_lvl.F90 real (kind=dbl_kind), public, & dimension (:,:,:,:), allocatable :: & @@ -354,6 +363,8 @@ subroutine alloc_arrays_column fzsal_g (nx_block,ny_block,max_blocks), & ! Total gravity drainage flux upNO (nx_block,ny_block,max_blocks), & ! nitrate uptake rate (mmol/m^2/d) times aice upNH (nx_block,ny_block,max_blocks), & ! ammonium uptake rate (mmol/m^2/d) times aice + meltsliq (nx_block,ny_block,max_blocks), & ! snow melt mass (kg/m^2) + meltsliqn (nx_block,ny_block,ncat,max_blocks), & ! snow melt mass in category n (kg/m^2) dhsn (nx_block,ny_block,ncat,max_blocks), & ! depth difference for snow on sea ice and pond ice ffracn (nx_block,ny_block,ncat,max_blocks), & ! fraction of fsurfn used to melt ipond alvdrn (nx_block,ny_block,ncat,max_blocks), & ! visible direct albedo (fraction) diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index b6b30d47a..ccb518807 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -51,6 +51,8 @@ module ice_fileunits nu_restart_lvl, & ! restart input file for level ice tracers nu_dump_pond , & ! dump file for restarting melt pond tracer nu_restart_pond,& ! restart input file for melt pond tracer + nu_dump_snow , & ! dump file for restarting snow redist/metamorph tracers + nu_restart_snow,& ! restart input file for snow redist/metamorph tracers nu_dump_fsd , & ! dump file for restarting floe size distribution nu_restart_fsd, & ! restart input file for floe size distribution nu_dump_iso , & ! dump file for restarting isotope tracers @@ -129,6 +131,8 @@ subroutine init_fileunits call get_fileunit(nu_restart_lvl) call get_fileunit(nu_dump_pond) call get_fileunit(nu_restart_pond) + call get_fileunit(nu_dump_snow) + call get_fileunit(nu_restart_snow) call get_fileunit(nu_dump_fsd) call get_fileunit(nu_restart_fsd) call get_fileunit(nu_dump_iso) @@ -218,6 +222,8 @@ subroutine release_all_fileunits call release_fileunit(nu_restart_lvl) call release_fileunit(nu_dump_pond) call release_fileunit(nu_restart_pond) + call release_fileunit(nu_dump_snow) + call release_fileunit(nu_restart_snow) call release_fileunit(nu_dump_fsd) call release_fileunit(nu_restart_fsd) call release_fileunit(nu_dump_iso) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 4f4641467..eff39a464 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -46,7 +46,7 @@ module ice_init_column init_age, init_FY, init_lvl, init_fsd, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & init_aerosol, init_bgc, init_hbrine, init_zbgc, input_zbgc, & - count_tracers, init_isotope + count_tracers, init_isotope, init_snowtracers ! namelist parameters needed locally @@ -214,8 +214,9 @@ subroutine init_shortwave logical (kind=log_kind) :: & l_print_point, & ! flag to print designated grid point diagnostics debug, & ! if true, print diagnostics - dEdd_algae, & ! from icepack - modal_aero ! from icepack + dEdd_algae, & ! use prognostic chla in dEdd radiation + modal_aero, & ! use modal aerosol optical treatment + snwgrain ! use variable snow radius character (char_len) :: shortwave @@ -225,12 +226,13 @@ subroutine init_shortwave real (kind=dbl_kind), dimension(ncat) :: & fbri ! brine height to ice thickness - real(kind=dbl_kind), allocatable :: & - ztrcr_sw(:,:) ! + 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_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) :: & @@ -243,17 +245,19 @@ subroutine init_shortwave 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_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 @@ -330,8 +334,14 @@ subroutine init_shortwave fbri(:) = c0 ztrcr_sw(:,:) = c0 + rsnow (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,j,nt_fbri,n,iblk) + 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 @@ -379,6 +389,7 @@ subroutine init_shortwave 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), & + rsnow=rsnow(:,:), & l_print_point=l_print_point, & initonly = .true.) endif @@ -475,6 +486,7 @@ subroutine init_shortwave enddo ! iblk deallocate(ztrcr_sw) + deallocate(rsnow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -587,6 +599,29 @@ 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) @@ -1776,10 +1811,12 @@ subroutine count_tracers 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_cesm, 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, & @@ -1862,7 +1899,7 @@ subroutine count_tracers tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_pond_out=tr_pond, & tr_pond_cesm_out=tr_pond_cesm, 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_iso_out=tr_iso, & + 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, & @@ -1925,6 +1962,21 @@ subroutine count_tracers 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 @@ -2212,7 +2264,7 @@ subroutine count_tracers !tcx, +1 here is the unused tracer, want to get rid of it ntrcr = ntrcr + 1 -!tcx, reset unusaed tracer index, eventually get rid of it. +!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 @@ -2220,6 +2272,10 @@ subroutine count_tracers 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 @@ -2246,6 +2302,7 @@ subroutine count_tracers 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, & diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index e819b1098..074b37dbe 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -12,7 +12,7 @@ module ice_restart_column use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, p5 use ice_constants, only: field_loc_center, field_type_scalar - use ice_domain_size, only: ncat, nfsd, nblyr + use ice_domain_size, only: ncat, nslyr, nfsd, nblyr use ice_restart,only: read_restart_field, write_restart_field use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag @@ -32,6 +32,7 @@ module ice_restart_column write_restart_pond_cesm, read_restart_pond_cesm, & write_restart_pond_lvl, read_restart_pond_lvl, & write_restart_pond_topo, read_restart_pond_topo, & + write_restart_snow, read_restart_snow, & write_restart_fsd, read_restart_fsd, & write_restart_iso, read_restart_iso, & write_restart_aero, read_restart_aero, & @@ -45,6 +46,7 @@ module ice_restart_column restart_pond_cesm, & ! if .true., read meltponds restart file restart_pond_lvl , & ! if .true., read meltponds restart file restart_pond_topo, & ! if .true., read meltponds restart file + restart_snow , & ! if .true., read snow tracer restart file restart_fsd , & ! if .true., read floe size restart file restart_iso , & ! if .true., read isotope tracer restart file restart_aero , & ! if .true., read aerosol tracer restart file @@ -483,6 +485,93 @@ end subroutine read_restart_pond_topo !======================================================================= +! Dumps all values needed for restarting snow redistribution/metamorphism +! author Elizabeth C. Hunke, LANL + + subroutine write_restart_snow() + + use ice_fileunits, only: nu_dump_snow + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: diag + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character*3 ck + character(len=*),parameter :: subname='(write_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, 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__) + + diag = .true. + + !----------------------------------------------------------------- + + do k = 1,nslyr + write(ck,'(i3.3)') k + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_smice+k-1,:,:), & + 'ruf8','smice'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_smliq+k-1,:,:), & + 'ruf8','smliq'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_rhos+k-1,:,:), & + 'ruf8','rhos'//trim(ck),ncat,diag) + call write_restart_field(nu_dump_snow,0, trcrn(:,:,nt_rsnw+k-1,:,:), & + 'ruf8','rsnw'//trim(ck),ncat,diag) + enddo + + end subroutine write_restart_snow + +!======================================================================= + +! Reads all values needed for a restart with snow redistribution/metamorphism +! author Elizabeth C. Hunke, LANL + + subroutine read_restart_snow() + + use ice_fileunits, only: nu_restart_snow + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: & + diag + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character*3 ck + character(len=*),parameter :: subname='(read_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, 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__) + + diag = .true. + + if (my_task == master_task) write(nu_diag,*) subname,'min/max snow tracers' + + do k=1,nslyr + write(ck,'(i3.3)') k + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_smice+k-1,:,:), & + 'ruf8','smice'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_smliq+k-1,:,:), & + 'ruf8','smliq'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_rhos+k-1,:,:), & + 'ruf8','rhos'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + call read_restart_field(nu_restart_snow,0,trcrn(:,:,nt_rsnw+k-1,:,:), & + 'ruf8','rsnw'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + enddo + + end subroutine read_restart_snow + +!======================================================================= + ! Dumps all values needed for restarting ! author Elizabeth C. Hunke, LANL diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index f9631a91d..3dec72963 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -100,6 +100,8 @@ restart_pond_topo = .false. tr_pond_lvl = .true. restart_pond_lvl = .false. + tr_snow = .false. + restart_snow = .false. tr_iso = .false. restart_iso = .false. tr_aero = .false. @@ -197,6 +199,28 @@ pndaspect = 0.8 / +&snow_nml + snwredist = 'none' + snwgrain = .false. + use_smliq_pnd = .false. + rsnw_fall = 100.0 + rsnw_tmax = 1500.0 + rhosnew = 100.0 + rhosmin = 100.0 + rhosmax = 450.0 + windmin = 10.0 + drhosdwind = 27.3 + snwlvlfac = 0.3 + snw_aging_table = 'test' + snw_filename = 'unknown' + snw_rhos_fname = 'unknown' + snw_Tgrd_fname = 'unknown' + snw_T_fname = 'unknown' + snw_tau_fname = 'unknown' + snw_kappa_fname = 'unknown' + snw_drdt0_fname = 'unknown' +/ + &forcing_nml formdrag = .false. atmbndy = 'default' @@ -584,6 +608,21 @@ f_apeff_ai = 'm' / +&icefields_snow_nml + f_smassicen = 'x' + f_smassliqn = 'x' + f_rhos_cmpn = 'x' + f_rhos_cntn = 'x' + f_rsnwn = 'x' + f_smassice = 'm' + f_smassliq = 'm' + f_rhos_cmp = 'm' + f_rhos_cnt = 'm' + f_rsnw = 'm' + f_meltsliq = 'm' + f_fsloss = 'm' +/ + &icefields_bgc_nml f_fiso_atm = 'x' f_fiso_ocn = 'x' diff --git a/configuration/scripts/options/set_nml.snw30percent b/configuration/scripts/options/set_nml.snw30percent new file mode 100644 index 000000000..ecf88ad4e --- /dev/null +++ b/configuration/scripts/options/set_nml.snw30percent @@ -0,0 +1,5 @@ +tr_snow = .true. +snwredist = 'bulk' +snwlvlfac = 0.3 +nslyr = 5 + diff --git a/configuration/scripts/options/set_nml.snwITDrdg b/configuration/scripts/options/set_nml.snwITDrdg new file mode 100644 index 000000000..cddeedec3 --- /dev/null +++ b/configuration/scripts/options/set_nml.snwITDrdg @@ -0,0 +1,10 @@ +tr_snow = .true. +snwredist = 'ITDrdg' +nslyr = 5 +rhosnew = 100.0 +rhosmin = 100.0 +rhosmax = 450.0 +windmin = 10.0 +drhosdwind = 27.3 +snwlvlfac = 0.3 + diff --git a/configuration/scripts/options/set_nml.snwgrain b/configuration/scripts/options/set_nml.snwgrain new file mode 100644 index 000000000..653030385 --- /dev/null +++ b/configuration/scripts/options/set_nml.snwgrain @@ -0,0 +1,15 @@ +tr_snow = .true. +snwgrain = .true. +use_smliq_pnd = .true. +rsnw_fall = 54.526 +rsnw_tmax = 1500.0 +snw_aging_table = 'file' +snw_filename = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/snicar_drdt_bst_fit_60_c04262019.nc' +snw_tau_fname = 'snowEmpiricalGrowthParameterTau' +snw_kappa_fname = 'snowEmpiricalGrowthParameterKappa' +snw_drdt0_fname = 'snowPropertyRate' +snw_rhos_fname = 'nGrainAgingSnowDensity' +snw_Tgrd_fname = 'nGrainAgingTempGradient' +snw_T_fname = 'nGrainAgingTemperature' +nslyr = 5 + diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 78df9ac81..7aac29450 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -58,6 +58,9 @@ restart gx3 4x2 fsd12,debug,short smoke gx3 8x2 fsd12ww3,diag24,run1day smoke gx3 4x1 isotope,debug restart gx3 8x2 isotope +smoke gx3 4x1 snwITDrdg,snwgrain,icdefault,debug +smoke gx3 4x1 snw30percent,icdefault,debug +restart gx3 8x2 snwITDrdg,icdefault,snwgrain restart gx3 4x4 gx3ncarbulk,iobinary restart gx3 4x4 histall,precision8,cdf64 smoke gx3 30x1 bgcz,histall diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 2efcd0335..0a04b5e26 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -168,6 +168,7 @@ either Celsius or Kelvin units). "dms", "dimethyl sulfide concentration", "mmol/m\ :math:`^3`" "dmsp", "dimethyl sulfoniopropionate concentration", "mmol/m\ :math:`^3`" "dpscale", "time scale for flushing in permeable ice", ":math:`1\times 10^{-3}`" + "drhosdwind", "wind compaction factor for snow", "27.3 kg s/m\ :math:`^{4}`" "dragio", "drag coefficient for water on ice", "0.00536" "dSdt_slow_mode", "drainage strength parameter", "" "dsnow", "change in snow thickness", "m" @@ -256,6 +257,7 @@ either Celsius or Kelvin units). "fsnow", "snowfall rate", "kg/m\ :math:`^2`/s" "fsnowrdg", "snow fraction that survives in ridging", "0.5" "fsurf(n)(_f)", "net surface heat flux excluding fcondtop", "W/m\ :math:`^2`" + "fsloss", "rate of snow loss to leads", "kg/m\ :math:`^{2}` s" "fsw", "incoming shortwave radiation", "W/m\ :math:`^2`" "fswabs", "total absorbed shortwave radiation", "W/m\ :math:`^2`" "fswfac", "scaling factor to adjust ice quantities for updated data", "" @@ -393,6 +395,8 @@ either Celsius or Kelvin units). "meltb", "basal ice melt", "m" "meltl", "lateral ice melt", "m" "melts", "snow melt", "m" + "meltsliq", "snow melt mass", "kg/m\ :math:`^{2}`" + "meltsliqn", "snow melt mass in category n", "kg/m\ :math:`^{2}`" "meltt", "top ice melt", "m" "min_salin", "threshold for brine pockets", "0.1 ppt" "mlt_onset", "day of year that surface melt begins", "" @@ -556,14 +560,21 @@ either Celsius or Kelvin units). "rhofresh", "density of fresh water", "1000.0 kg/m\ :math:`^3`" "rhoi", "density of ice", "917. kg/m\ :math:`^3`" "rhos", "density of snow", "330. kg/m\ :math:`^3`" + "rhos_cmp", "density of snow due to wind compaction", "kg/m\ :math:`^3`" + "rhos_cnt", "density of ice and liquid content of snow", "kg/m\ :math:`^3`" "rhosi", "average sea ice density (for hbrine tracer)", "940. kg/m\ :math:`^3`" + "rhosmax", "maximum snow density", "450 kg/m\ :math:`^{3}`" + "rhosmin", "minimum snow density", "100 kg/m\ :math:`^{3}`" + "rhosnew", "new snow density", "100 kg/m\ :math:`^{3}`" "rhow", "density of seawater", "1026. kg/m\ :math:`^3`" "rnilyr", "real(nlyr)", "" "rside", "fraction of ice that melts laterally", "" - "rsnw_fresh", "freshly fallen snow grain radius", "100. :math:`\times` 10\ :math:`^{-6}` m" + "rsnw", "snow grain radius", "10\ :math:`^{-6}` m" + "rsnw_fall", "freshly fallen snow grain radius", "100. :math:`\times` 10\ :math:`^{-6}` m" "rsnw_melt", "melting snow grain radius", "1000. :math:`\times` 10\ :math:`^{-6}` m" "rsnw_nonmelt", "nonmelting snow grain radius", "500. :math:`\times` 10\ :math:`^{-6}` m" "rsnw_sig", "standard deviation of snow grain radius", "250. :math:`\times` 10\ :math:`^{-6}` m" + "rsnw_tmax", "maximum snow radius", "1500. :math:`\times` 10\ :math:`^{-6}` m" "runid", "identifier for run", "" "runtype", "type of initialization used", "" "**S**", "", "" @@ -586,6 +597,25 @@ either Celsius or Kelvin units). "snoice", "snow–ice formation", "m" "snowpatch", "length scale for parameterizing nonuniform snow coverage", "0.02 m" "skl_bgc", "biogeochemistry on/off", "" + "smassice", "mass of ice in snow from smice tracer", "kg/m\ :math:`^2`" + "smassliq", "mass of liquid in snow from smliq tracer", "kg/m\ :math:`^2`" + "snowage_drdt0", "initial rate of change of effective snow radius", " " + "snowage_rhos", "snow aging parameter (density)", " " + "snowage_kappa", "snow aging best-fit parameter", " " + "snowage_tau", "snow aging best-fit parameter", " " + "snowage_T", "snow aging parameter (temperature)", " " + "snowage_Tgrd", "snow aging parameter (temperature gradient)", " " + "snw_aging_table", "snow aging lookup table", " " + "snw_filename", "snowtable filename", " " + "snw_tau_fname", "snowtable file tau fieldname", " " + "snw_kappa_fname", "snowtable file kappa fieldname", " " + "snw_drdt0_fname", "snowtable file drdt0 fieldname", " " + "snw_rhos_fname", "snowtable file rhos fieldname", " " + "snw_Tgrd_fname", "snowtable file Tgrd fieldname", " " + "snw_T_fname", "snowtable file T fieldname", " " + "snwgrain", "activate snow metamorphosis", " " + "snwlvlfac", "fractional increase in snow depth for redistribution on ridges", "0.3" + "snwredist", "type of snow redistribution", " " "spval", "special value (single precision)", ":math:`10^{30}`", "" "spval_dbl", "special value (double precision)", ":math:`10^{30}`", "" "ss_tltx(y)", "sea surface in the x(y) direction", "m/m" @@ -666,6 +696,7 @@ either Celsius or Kelvin units). "update_ocn_f", "if true, include frazil ice fluxes in ocean flux fields", "" "use_leap_years", "if true, include leap days", "" "use_restart_time", "if true, use date from restart file", "" + "use_smliq_pnd", "use liquid in snow for ponds", " " "ustar_min", "minimum friction velocity under ice", "" "ucstr", "string identifying U grid for history variables", "" "uvel", "x-component of ice velocity", "m/s" @@ -691,6 +722,7 @@ either Celsius or Kelvin units). "wave_spectrum", "wave spectrum", "m\ :math:`^2`/s" "wavefreq", "wave frequencies", "1/s" "wind", "wind speed", "m/s" + "windmin", "minimum wind speed to compact snow", "10 m/s" "write_history", "if true, write history now", "" "write_ic", "if true, write initial conditions", "" "write_restart", "if 1, write restart now", "" diff --git a/doc/source/developer_guide/dg_driver.rst b/doc/source/developer_guide/dg_driver.rst index a10cb319a..637e91b68 100644 --- a/doc/source/developer_guide/dg_driver.rst +++ b/doc/source/developer_guide/dg_driver.rst @@ -65,7 +65,6 @@ The initialize calling sequence looks something like:: call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat, hin_max) ! ice thickness distribution if (tr_fsd) call icepack_init_fsd_bounds ! floe size distribution - call calendar(time) ! determine the initial date call init_forcing_ocn(dt) ! initialize sss and sst from data call init_state ! initialize the ice state call init_transport ! initialize horizontal transport @@ -74,10 +73,13 @@ The initialize calling sequence looks something like:: 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 init_shortwave ! initialize radiative transfer + call advance_timestep ! advance the time step 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* ! read forcing data (standalone) + if (tr_snow) call icepack_init_snow ! advanced snow physics See a **CICE_InitMod.F90** file for the latest. @@ -105,6 +107,13 @@ The run sequence within a time loop looks something like:: call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) enddo + if (tr_snow) then ! advanced snow physics + do iblk = 1, nblocks + call step_snow (dt, iblk) + enddo + call update_state (dt) ! clean up + endif + do iblk = 1, nblocks call step_radiation (dt, iblk) call coupling_prep (iblk) diff --git a/doc/source/science_guide/sg_tracers.rst b/doc/source/science_guide/sg_tracers.rst index bbd18eb1f..215c13d08 100644 --- a/doc/source/science_guide/sg_tracers.rst +++ b/doc/source/science_guide/sg_tracers.rst @@ -90,6 +90,10 @@ is not in use. "tr_iso", "n_iso", "vice, vsno", "nt_iso"," " "tr_brine", " ", "vice", "nt_fbri", " " "tr_fsd","nfsd","aice","nt_fsd"," " + "tr_snow","nslyr","vsno","nt_rsnw"," " + " ","nslyr","vsno","nt_rhos"," " + " ","nslyr","vsno","nt_smice"," " + " ","nslyr","vsno","nt_smliq"," " "solve_zsal", "n_trzs", "fbri or (a,v)ice", "nt_bgc_S", " " "tr_bgc_N", "n_algae", "fbri or (a,v)ice", "nt_bgc_N", "nlt_bgc_N" "tr_bgc_Nit", " ", "fbri or (a,v)ice", "nt_bgc_Nit", "nlt_bgc_Nit" @@ -115,4 +119,4 @@ Users may add any number of additional tracers that are transported conservative provided that the dependency ``trcr_depend`` is defined appropriately. See Section :ref:`addtrcr` for guidance on adding tracers. -Please see the `Icepack documentation `_ for additional information about tracers that depend on other tracers, the floe size distribution, age of the ice, aerosols, water isotopes, brine height, and the sea ice ecosystem. +Please see the `Icepack documentation `_ for additional information about tracers that depend on other tracers, the floe size distribution, advanced snow physics, age of the ice, aerosols, water isotopes, brine height, and the sea ice ecosystem. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index b1f6b4614..65a50120b 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -327,6 +327,7 @@ tracer_nml "``tr_pond_cesm``", "logical", "CESM melt ponds", "``.false.``" "``tr_pond_lvl``", "logical", "level-ice melt ponds", "``.false.``" "``tr_pond_topo``", "logical", "topo melt ponds", "``.false.``" + "``tr_snow``", "logical", "advanced snow physics", "``.false.``" "``restart_aero``", "logical", "restart tracer values from file", "``.false.``" "``restart_age``", "logical", "restart tracer values from file", "``.false.``" "``restart_fsd``", "logical", "restart floe size distribution values from file", "``.false.``" @@ -485,6 +486,40 @@ ponds_nml "``rfracmin``", ":math:`0 \le r_{min} \le 1`", "minimum melt water added to ponds", "0.15" "", "", "", "" +snow_nml +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. csv-table:: **snow_nml namelist options** + :header: "variable", "options/format", "description", "default value" + :widths: 15, 15, 30, 15 + + "", "", "", "" + "``drhosdwind``", "real", "wind compactions factor for now in kg-s/m^4", "27.3" + "``rhosmax``", "real", "maximum snow density in kg/m^3", "450." + "``rhosmin``", "real", "minimum snow density in kg/m^3", "100." + "``rhosnew``", "real", "new snow density in kg/m^3", "100." + "``rsnw_fall``", "real", "radius of new snow in 1.0e-6 m", "100." + "``rsnw_tmax``", "real", "maximum snow radius in 1.0e-6 m", "1500." + "``snwgrain``", "logical", "snow metamorophsis flag", "``.false.``" + "``snwlvlfac``", "real", "fractional increase in snow", "0.3" + "``snwredist``", "``bulk``", "bulk snow redistribution scheme", "``none``" + "", "``ITD``", "ITD snow redistribution scheme", "" + "", "``ITDrdg``", "ITDrdg snow redistribution scheme", "" + "", "``none``", "snow redistribution scheme off", "" + "``snw_aging_table``", "file", "read 1D and 3D fields for dry metamorophsis lookup table", "test" + "", "snicar", "read 3D fields for dry metamorophsis lookup table", "" + "", "test", "internally generated dry metamorophsis lookup table for testing", "" + "``snw_drdt0_fname``", "string", "snow aging file drdt0 fieldname", "unknown" + "``snw_filename``", "string", "snow aging table data filename", "unknown" + "``snw_kappa_fname``", "string", "snow aging file kappa fieldname", "unknown" + "``snw_rhos_fname``", "string", "snow aging file rhos fieldname", "unknown" + "``snw_T_fname``", "string", "snow aging file T fieldname", "unknown" + "``snw_tau_fname``", "string", "snow aging file tau fieldname", "unknown" + "``snw_Tgrd_fname``", "string", "snow aging file Tgrd fieldname", "unknown" + "``use_smliq_pnd``", "logical", "use liquid in snow for ponds", "``.false.``" + "``windmin``", "real", "minimum wind speed to compact snow in m/s", "10." + "", "", "", "" + forcing_nml ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/icepack b/icepack index a80472b54..53ffce04d 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit a80472b547aa6d7a85f8ae5e1449273a323e0371 +Subproject commit 53ffce04d729a3e802b397340c4410126b5b0ac9 From 7b5c2b404addb356c75d87f7cb4ae2fa59bfc20b Mon Sep 17 00:00:00 2001 From: apcraig Date: Thu, 12 Aug 2021 16:57:18 -0600 Subject: [PATCH 11/15] Fix QC issues - Add netcdf ststus checks and aborts in ice_read_write.F90 - Check for end of file when reading records in ice_read_write.F90 for ice_read_nc methods - Update set_nml.qc to better specify the test, turn off leap years since we're cycling 2005 data - Add check in c ice.t-test.py to make sure there is at least 1825 files, 5 years of data - Add QC run to base_suite.ts to verify qc runs to completion and possibility to use those results directly for QC validation - Clean up error messages and some indentation in ice_read_write.F90 --- .../infrastructure/ice_read_write.F90 | 477 ++++++++++++------ configuration/scripts/options/set_nml.qc | 10 +- configuration/scripts/tests/QC/cice.t-test.py | 9 + configuration/scripts/tests/base_suite.ts | 1 + 4 files changed, 353 insertions(+), 144 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index d902c62f8..b8b749482 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -285,7 +285,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & read(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global) endif else - write(nu_diag,*) ' ERROR: reading unknown atype ',atype + write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype endif endif ! my_task = master_task @@ -304,7 +304,7 @@ subroutine ice_read_xyt(nu, nrec, work, atype, diag, & amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum(work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' read_global ',nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif !------------------------------------------------------------------- @@ -433,7 +433,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & k=1,nblyr+2) endif else - write(nu_diag,*) ' ERROR: reading unknown atype ',atype + write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype endif endif ! my_task = master_task @@ -452,7 +452,7 @@ subroutine ice_read_xyzt(nu, nrec, work, atype, diag, & amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) asum = sum (work_g4, mask = work_g4 /= spval_dbl) - write(nu_diag,*) ' read_global ',nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif !------------------------------------------------------------------- @@ -566,7 +566,7 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & read(nu) ((work_g(i,j),i=1,nx_global),j=1,ny_global) endif else - write(nu_diag,*) ' ERROR: reading unknown atype ',atype + write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype endif endif ! my_task = master_task @@ -582,7 +582,7 @@ subroutine ice_read_global (nu, nrec, work_g, atype, diag, & amin = minval(work_g) amax = maxval(work_g, mask = work_g /= spval_dbl) asum = sum (work_g, mask = work_g /= spval_dbl) - write(nu_diag,*) ' read_global ',nu, nrec, amin, amax,asum + write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax,asum endif end subroutine ice_read_global @@ -686,7 +686,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & read(nu) ((work_g1(i,j),i=1,nx),j=1,ny) endif else - write(nu_diag,*) ' ERROR: reading unknown atype ',atype + write(nu_diag,*) subname,' ERROR: reading unknown atype ',atype endif endif ! my_task = master_task @@ -705,7 +705,7 @@ subroutine ice_read_ext(nu, nrec, work, atype, diag, & amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum (work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' read_global ',nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' read_global ',nu, nrec, amin, amax, asum endif !------------------------------------------------------------------- @@ -800,7 +800,7 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) elseif (atype == 'ruf8') then write(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global) else - write(nu_diag,*) ' ERROR: writing unknown atype ',atype + write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif !------------------------------------------------------------------- @@ -810,7 +810,7 @@ subroutine ice_write_xyt(nu, nrec, work, atype, diag) amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum (work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' write_global ', nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum endif endif ! my_task = master_task @@ -905,7 +905,7 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) write(nu)(((work_g4(i,j,k),i=1,nx_global),j=1,ny_global), & k=1,nblyr+2) else - write(nu_diag,*) ' ERROR: writing unknown atype ',atype + write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif !------------------------------------------------------------------- @@ -915,7 +915,7 @@ subroutine ice_write_xyzt(nu, nrec, work, atype, diag) amin = minval(work_g4) amax = maxval(work_g4, mask = work_g4 /= spval_dbl) asum = sum (work_g4, mask = work_g4 /= spval_dbl) - write(nu_diag,*) ' write_global ', nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum endif endif ! my_task = master_task @@ -1011,7 +1011,7 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) elseif (atype == 'ruf8') then write(nu) ((work_g1(i,j),i=1,nx),j=1,ny) else - write(nu_diag,*) ' ERROR: writing unknown atype ',atype + write(nu_diag,*) subname,' ERROR: writing unknown atype ',atype endif !------------------------------------------------------------------- @@ -1021,7 +1021,7 @@ subroutine ice_write_ext(nu, nrec, work, atype, diag) amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum (work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' write_global ', nu, nrec, amin, amax, asum + write(nu_diag,*) subname,' write_global ', nu, nrec, amin, amax, asum endif endif ! my_task = master_task @@ -1055,14 +1055,15 @@ subroutine ice_open_nc(filename, fid) status = nf90_open(filename, NF90_NOWRITE, fid) if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot open '//trim(filename) ) + call abort_ice(subname//' ERROR: Cannot open '//trim(filename), & + file=__FILE__, line=__LINE__) endif endif ! my_task = master_task #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename), & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined for '//trim(filename), & + file=__FILE__, line=__LINE__) fid = -999 ! to satisfy intent(out) attribute #endif end subroutine ice_open_nc @@ -1110,26 +1111,29 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & varid , & ! variable id - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! dimension size + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size + + integer (kind=int_kind), dimension(10) :: & + dimids ! generic size dimids real (kind=dbl_kind) :: & missingvalue, & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & -! dimname ! dimension name - real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 integer (kind=int_kind) :: nx, ny + integer (kind=int_kind) :: lnrec ! local value of nrec + real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g2 + lnrec = nrec + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1)) @@ -1164,9 +1168,31 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- + + status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (ndims > 2) then + status = nf90_inquire_dimension(fid, dimids(3), len=dimlen) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire dimension size 3 '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (lnrec > dimlen) then + write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + call abort_ice(subname//' ERROR: not enough records '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif !-------------------------------------------------------------- @@ -1175,13 +1201,21 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/) ) + start=(/1,1,lnrec/), & + count=(/nx_global+2,ny_global+1,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif work_g1 = work_g2(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/) ) + start=(/1,1,lnrec/), & + count=(/nx,ny,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif status = nf90_get_att(fid, varid, "_FillValue", missingvalue) @@ -1192,19 +1226,19 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then - write(nu_diag,*) & - 'ice_read_nc_xy, fid= ',fid, ', nrec = ',nrec, & + write(nu_diag,'(2a,i8,a,i8,2a)') & + subname,' fid= ',fid, ', lnrec = ',lnrec, & ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) -! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar +! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) -! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen +! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= missingvalue) asum = sum (work_g1, mask = work_g1 /= missingvalue) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(varname) + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif !------------------------------------------------------------------- @@ -1234,8 +1268,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_read_nc_xy @@ -1282,11 +1316,13 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & n, & ! ncat index - varid , & ! variable id - status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension + varid , & ! variable id + status , & ! status output from netcdf routines + ndims , & ! number of dimensions + dimlen ! dimension size + + integer (kind=int_kind), dimension(10) :: & + dimids ! generic size dimids real (kind=dbl_kind) :: & missingvalue, & ! missing value @@ -1300,9 +1336,13 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny + integer (kind=int_kind) :: lnrec ! local value of nrec + real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 + lnrec = nrec + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1,ncat)) @@ -1335,9 +1375,31 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- + + status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (ndims > 3) then + status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (lnrec > dimlen) then + write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + call abort_ice(subname//' ERROR: not enough records '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif !-------------------------------------------------------------- @@ -1346,13 +1408,21 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,nrec/), & - count=(/nx_global+2,ny_global+1,ncat,1/) ) + start=(/1,1,1,lnrec/), & + count=(/nx_global+2,ny_global+1,ncat,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/) ) + start=(/1,1,1,lnrec/), & + count=(/nx,ny,ncat,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif status = nf90_get_att(fid, varid, "_FillValue", missingvalue) @@ -1363,20 +1433,20 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then - write(nu_diag,*) & - 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & + write(nu_diag,'(2a,i8,a,i8,2a)') & + subname,' fid= ',fid, ', lnrec = ',lnrec, & ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) -! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar +! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) -! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen +! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo do n=1,ncat amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(varname) + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) enddo endif @@ -1410,8 +1480,8 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xyz @@ -1465,7 +1535,11 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ndim, nvar, & ! sizes of netcdf file id, & ! dimension index n, & ! ncat index - dimlen ! size of dimension + ndims, & ! number of dimensions + dimlen ! dimension size + + integer (kind=int_kind), dimension(10) :: & + dimids ! generic size dimids real (kind=dbl_kind) :: & missingvalue, & ! missing value @@ -1479,12 +1553,16 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny + integer (kind=int_kind) :: lnrec ! local value of nrec + character(len=*), parameter :: subname = '(ice_read_nc_xyf)' #ifdef USE_NETCDF real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 + lnrec = nrec + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1,nfreq)) @@ -1517,10 +1595,31 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice ( & - 'ice_read_nc_xyf: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- + + status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (ndims > 3) then + status = nf90_inquire_dimension(fid, dimids(4), len=dimlen) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire dimension size 4 '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (lnrec > dimlen) then + write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + call abort_ice(subname//' ERROR: not enough records '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif !-------------------------------------------------------------- @@ -1529,13 +1628,21 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) then status = nf90_get_var( fid, varid, work_g2, & - start=(/1,1,1,nrec/), & - count=(/nx_global+2,ny_global+1,nfreq,1/) ) + start=(/1,1,1,lnrec/), & + count=(/nx_global+2,ny_global+1,nfreq,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif work_g1 = work_g2(2:nx_global+1,1:ny_global,:) else status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,nfreq,1/) ) + start=(/1,1,1,lnrec/), & + count=(/nx,ny,nfreq,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif status = nf90_get_att(fid, varid, "missing_value", missingvalue) @@ -1546,21 +1653,21 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then - write(nu_diag,*) & - 'ice_read_nc_xyf, fid= ',fid, ', nrec = ',nrec, & + write(nu_diag,'(2a,i8,a,i8,2a)') & + subname,' fid= ',fid, ', lnrec = ',lnrec, & ', varname = ',trim(varname) status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) - write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar do id=1,ndim status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) - write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen + write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo - write(nu_diag,*) 'missingvalue= ',missingvalue + write(nu_diag,*) subname,' missingvalue= ',missingvalue do n = 1, nfreq amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= missingvalue) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum enddo endif @@ -1597,8 +1704,8 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & if (orca_halogrid .and. .not. present(restart_ext)) deallocate(work_g2) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -1640,24 +1747,54 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & status, & ! status output from netcdf routines ndim, nvar, & ! sizes of netcdf file id, & ! dimension index - dimlen ! size of dimension + ndims, & ! number of dimensions + dimlen ! dimension size + + integer (kind=int_kind), dimension(10) :: & + dimids ! generic size dimids real (kind=dbl_kind), dimension(1) :: & workg ! temporary work variable + integer (kind=int_kind) :: lnrec ! local value of nrec + character (char_len) :: & dimname ! dimension name - if (my_task == master_task) then + lnrec = nrec + + if (my_task == master_task) then !------------------------------------------------------------- ! Find out ID of required variable !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- + + status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (ndims > 0) then + status = nf90_inquire_dimension(fid, dimids(1), len=dimlen) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire dimension size 1 '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (lnrec > dimlen) then + write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + call abort_ice(subname//' ERROR: not enough records '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif !-------------------------------------------------------------- @@ -1665,11 +1802,11 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & !-------------------------------------------------------------- status = nf90_get_var(fid, varid, workg, & - start= (/ nrec /), & - count=(/ 1 /) ) - - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot get variable '//trim(varname) ) + start= (/ lnrec /), & + count=(/ 1 /)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif endif ! my_task = master_task @@ -1678,22 +1815,22 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then - write(nu_diag,*) & - 'ice_read_nc_point, fid= ',fid, ', nrec = ',nrec, & + write(nu_diag,'(2a,i8,a,i8,2a)') & + subname,' fid= ',fid, ', lnrec = ',lnrec, & ', varname = ',trim(varname) status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) - write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar do id=1,ndim status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) - write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen + write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo endif work = workg(1) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_point @@ -1736,16 +1873,25 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & status, & ! status output from netcdf routines ndim, nvar, & ! sizes of netcdf file id, & ! dimension index - dimlen ! size of dimension + ndims, & ! number of dimensions + dimlen ! dimension size + + integer (kind=int_kind), dimension(10) :: & + dimids ! generic size dimids character (char_len) :: & dimname ! dimension name + + integer (kind=int_kind) :: lnrec ! local value of nrec + #endif character(len=*), parameter :: subname = '(ice_read_nc_z)' #ifdef USE_NETCDF + lnrec = nrec + allocate(work_z(nilyr)) if (my_task == master_task) then @@ -1755,9 +1901,31 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + + !------------------------------------------------------------- + ! Check nrec axis size + !------------------------------------------------------------- + + status = nf90_inquire_variable(fid, varid, ndims=ndims, dimids=dimids) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire variable dimids '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (ndims > 1) then + status = nf90_inquire_dimension(fid, dimids(2), len=dimlen) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: inquire dimension size 2 '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + if (lnrec > dimlen) then + write(nu_diag,*) subname,' ERROR not enough records, ',trim(varname),lnrec,dimlen + call abort_ice(subname//' ERROR: not enough records '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif !-------------------------------------------------------------- @@ -1765,9 +1933,12 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & !-------------------------------------------------------------- status = nf90_get_var( fid, varid, work_z, & - start=(/1,nrec/), & - count=(/nilyr,1/) ) - + start=(/1,lnrec/), & + count=(/nilyr,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif ! my_task = master_task !------------------------------------------------------------------- @@ -1775,14 +1946,14 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & !------------------------------------------------------------------- if (my_task==master_task .and. diag) then - write(nu_diag,*) & - 'ice_read_nc_z, fid= ',fid, ', nrec = ',nrec, & + write(nu_diag,'(2a,i8,a,i8,2a)') & + subname,' fid= ',fid, ', lnrec = ',lnrec, & ', varname = ',trim(varname) status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) - write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar + write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar do id=1,ndim status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) - write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen + write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen enddo endif @@ -1790,8 +1961,8 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & deallocate(work_z) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_z @@ -1826,7 +1997,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & ! local variables - character(len=*), parameter :: subname = '(ice_read_nc_xy)' + character(len=*), parameter :: subname = '(ice_write_nc_xy)' #ifdef USE_NETCDF ! netCDF file diagnostics: @@ -1886,7 +2057,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & status = nf90_put_var( fid, varid, work_g1, & start=(/1,1,nrec/), & - count=(/nx,ny,1/) ) + count=(/nx,ny,1/)) endif ! my_task = master_task @@ -1896,25 +2067,25 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & if (my_task==master_task .and. diag) then ! write(nu_diag,*) & -! 'ice_write_nc_xy, fid= ',fid, ', nrec = ',nrec, & +! subname,' fid= ',fid, ', nrec = ',nrec, & ! ', varid = ',varid ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) -! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar +! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) -! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen +! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum (work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(lvarname) + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(lvarname) endif deallocate(work_g1) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_nc_xy @@ -1949,7 +2120,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & ! local variables - character(len=*), parameter :: subname = '(ice_read_nc_xyz)' + character(len=*), parameter :: subname = '(ice_write_nc_xyz)' #ifdef USE_NETCDF ! netCDF file diagnostics: @@ -2016,7 +2187,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & status = nf90_put_var( fid, varid, work_g1, & start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/) ) + count=(/nx,ny,ncat,1/)) endif ! my_task = master_task @@ -2026,13 +2197,13 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & if (my_task==master_task .and. diag) then ! write(nu_diag,*) & -! 'ice_write_nc_xyz, fid= ',fid, ', nrec = ',nrec, & +! subname,' fid= ',fid, ', nrec = ',nrec, & ! ', varid = ',varid ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) -! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar +! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) -! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen +! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo amin = 10000._dbl_kind amax = -10000._dbl_kind @@ -2040,15 +2211,15 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & amin = minval(work_g1(:,:,n)) amax = maxval(work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl) asum = sum (work_g1(:,:,n), mask = work_g1(:,:,n) /= spval_dbl) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(lvarname) + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(lvarname) enddo endif deallocate(work_g1) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_nc_xyz @@ -2117,9 +2288,9 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif !-------------------------------------------------------------- @@ -2129,12 +2300,20 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) if (orca_halogrid) then status = nf90_get_var( fid, varid, work_g3, & start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/) ) + count=(/nx_global+2,ny_global+1,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif work_g=work_g3(2:nx_global+1,1:ny_global) else status = nf90_get_var( fid, varid, work_g, & start=(/1,1,nrec/), & - count=(/nx_global,ny_global,1/) ) + count=(/nx_global,ny_global,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif endif ! my_task = master_task @@ -2144,25 +2323,25 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) if (my_task == master_task .and. diag) then ! write(nu_diag,*) & -! 'ice_read_global_nc, fid= ',fid, ', nrec = ',nrec, & +! subname,' fid= ',fid, ', nrec = ',nrec, & ! ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) -! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar +! write(nu_diag,*) subname,' ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim ! status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen) -! write(nu_diag,*) 'Dim name = ',trim(dimname),', size = ',dimlen +! write(nu_diag,*) subname,' Dim name = ',trim(dimname),', size = ',dimlen ! enddo amin = minval(work_g) amax = maxval(work_g, mask = work_g /= spval_dbl) asum = sum (work_g, mask = work_g /= spval_dbl) - write(nu_diag,*) 'min, max, sum = ', amin, amax, asum, trim(varname) + write(nu_diag,*) subname,' min, max, sum = ', amin, amax, asum, trim(varname) endif if (orca_halogrid) deallocate(work_g3) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif @@ -2190,8 +2369,8 @@ subroutine ice_close_nc(fid) status = nf90_close(fid) endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_close_nc @@ -2279,9 +2458,9 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif !-------------------------------------------------------------- @@ -2290,7 +2469,11 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & status = nf90_get_var( fid, varid, work_g1, & start=(/1,1,nzlev,nrec/), & - count=(/nx,ny,1,1/) ) + count=(/nx,ny,1,1/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif endif ! my_task = master_task @@ -2302,7 +2485,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & amin = minval(work_g1) amax = maxval(work_g1, mask = work_g1 /= spval_dbl) asum = sum (work_g1, mask = work_g1 /= spval_dbl) - write(nu_diag,*) ' min, max, sum =', amin, amax, asum, trim(varname) + write(nu_diag,*) subname,' min, max, sum =', amin, amax, asum, trim(varname) endif !------------------------------------------------------------------- @@ -2327,8 +2510,8 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & deallocate(work_g1) #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work = c0 ! to satisfy intent(out) attribute #endif @@ -2380,9 +2563,9 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) !------------------------------------------------------------- status = nf90_inq_varid(fid, trim(varname), varid) - if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: Cannot find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Cannot find variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif !-------------------------------------------------------------- @@ -2391,7 +2574,12 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) status = nf90_get_var( fid, varid, work_g, & start=(/1/), & - count=(/nrec/) ) + count=(/nrec/)) + if (status /= nf90_noerr) then + call abort_ice(subname//' ERROR: Cannot get variable '//trim(varname), & + file=__FILE__, line=__LINE__) + endif + endif ! my_task = master_task !------------------------------------------------------------------- @@ -2401,12 +2589,12 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) if (my_task == master_task .and. diag) then amin = minval(work_g) amax = maxval(work_g) - write(nu_diag,*) 'min, max, nrec = ', amin, amax, nrec + write(nu_diag,*) subname,' min, max, nrec = ', amin, amax, nrec endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif @@ -2437,22 +2625,25 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) if (my_task == master_task) then status=nf90_inquire(fid, nDimensions = nDims) if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: inquire nDimensions' ) + call abort_ice(subname//' ERROR: inquire nDimensions', & + file=__FILE__, line=__LINE__ ) endif do i=1,nDims status = nf90_inquire_dimension(fid,i,name=cvar,len=recsize) if (status /= nf90_noerr) then - call abort_ice (subname//'ERROR: inquire len for variable '//trim(cvar) ) + call abort_ice(subname//' ERROR: inquire len for variable '//trim(cvar), & + file=__FILE__, line=__LINE__) endif if (trim(cvar) == trim(varname)) exit enddo if (trim(cvar) .ne. trim(varname)) then - call abort_ice (subname//'ERROR: Did not find variable '//trim(varname) ) + call abort_ice(subname//' ERROR: Did not find variable '//trim(varname), & + file=__FILE__, line=__LINE__) endif endif #else - call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & - file=__FILE__, line=__LINE__) + call abort_ice(subname//' ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif diff --git a/configuration/scripts/options/set_nml.qc b/configuration/scripts/options/set_nml.qc index 2b1528cc5..70ba1b429 100644 --- a/configuration/scripts/options/set_nml.qc +++ b/configuration/scripts/options/set_nml.qc @@ -1,4 +1,12 @@ -npt = 43800 +npt_unit = 'y' +npt = 5 +year_init = 2005 +month_init = 1 +day_init = 1 +sec_init = 0 +use_leap_years = .false. +fyear_init = 2005 +ycycle = 1 dumpfreq = 'm' dumpfreq_n = 12 diagfreq = 24 diff --git a/configuration/scripts/tests/QC/cice.t-test.py b/configuration/scripts/tests/QC/cice.t-test.py index 987175245..6f2c7e89b 100755 --- a/configuration/scripts/tests/QC/cice.t-test.py +++ b/configuration/scripts/tests/QC/cice.t-test.py @@ -57,6 +57,15 @@ def gen_filenames(base_dir, test_dir): " # of files: {}".format(len(files_b))) sys.exit(-1) + if len(files_a) < 1825: + logger.error("Number of output files too small, expecting at least 1825." + \ + " Exiting...\n" + \ + "Baseline directory: {}\n".format(path_a) + \ + " # of files: {}\n".format(len(files_a)) + \ + "Test directory: {}\n".format(path_b) + \ + " # of files: {}".format(len(files_b))) + sys.exit(-1) + logger.info("Number of files: %d", len(files_a)) return path_a, path_b, files_a, files_b diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 78df9ac81..b94be6219 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -4,6 +4,7 @@ smoke gx3 1x1 debug,diag1,run2day smoke gx3 1x4 debug,diag1,run2day smoke gx3 4x1 debug,diag1,run5day restart gx3 8x2 debug +smoke gx1 64x1 qc,medium smoke gx3 8x2 diag24,run1year,medium smoke gx3 7x2 diag1,bigdiag,run1day,diagpt1 decomp gx3 4x2x25x29x5 none From c5794b4b5c6162d2d148215dadaf6b31d119714f Mon Sep 17 00:00:00 2001 From: apcraig Date: Thu, 12 Aug 2021 23:49:05 -0600 Subject: [PATCH 12/15] Update testing - Add prod suite including 10 year gx1prod and qc test - Update unit test compare scripts --- cicecore/drivers/unittest/bcstchk/bcstchk.F90 | 2 +- cicecore/drivers/unittest/calchk/calchk.F90 | 2 +- cicecore/drivers/unittest/helloworld/helloworld.F90 | 2 +- cicecore/drivers/unittest/sumchk/sumchk.F90 | 2 +- configuration/scripts/options/set_nml.run10year | 7 +++++++ configuration/scripts/tests/base_suite.ts | 1 - configuration/scripts/tests/comparelog.csh | 4 ++-- configuration/scripts/tests/prod_suite.ts | 3 +++ 8 files changed, 16 insertions(+), 7 deletions(-) create mode 100644 configuration/scripts/options/set_nml.run10year create mode 100644 configuration/scripts/tests/prod_suite.ts diff --git a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 index d267f77e6..264931780 100644 --- a/cicecore/drivers/unittest/bcstchk/bcstchk.F90 +++ b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 @@ -51,7 +51,7 @@ program bcstchk write(6,*) ' ' write(6,*) '==========================================================' write(6,*) ' ' - write(6,*) 'Running BCSTCHK' + write(6,*) 'RunningUnitTest BCSTCHK' write(6,*) ' ' write(6,*) ' npes = ',npes write(6,*) ' my_task = ',my_task diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 index 6fa99e4dd..3c340eb26 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -41,7 +41,7 @@ program calchk failflag = 'FAIL' write(6,*) ' ' - write(6,*) 'Running CALCHK' + write(6,*) 'RunningUnitTest CALCHK' write(6,*) ' ' errorflag0 = passflag diff --git a/cicecore/drivers/unittest/helloworld/helloworld.F90 b/cicecore/drivers/unittest/helloworld/helloworld.F90 index 435d5479e..c4e4ae91f 100644 --- a/cicecore/drivers/unittest/helloworld/helloworld.F90 +++ b/cicecore/drivers/unittest/helloworld/helloworld.F90 @@ -1,7 +1,7 @@ program hello_world - write(6,*) 'hello_world' + write(6,*) 'RunningUnitTest hello_world' write(6,*) 'hello_world COMPLETED SUCCESSFULLY' write(6,*) 'hello_world TEST COMPLETED SUCCESSFULLY' diff --git a/cicecore/drivers/unittest/sumchk/sumchk.F90 b/cicecore/drivers/unittest/sumchk/sumchk.F90 index 210ca669f..f314959cb 100644 --- a/cicecore/drivers/unittest/sumchk/sumchk.F90 +++ b/cicecore/drivers/unittest/sumchk/sumchk.F90 @@ -107,7 +107,7 @@ program sumchk write(6,*) ' ' write(6,*) '==========================================================' write(6,*) ' ' - write(6,*) 'Running SUMCHK' + write(6,*) 'RunningUnitTest SUMCHK' write(6,*) ' ' write(6,*) ' npes = ',npes write(6,*) ' my_task = ',my_task diff --git a/configuration/scripts/options/set_nml.run10year b/configuration/scripts/options/set_nml.run10year new file mode 100644 index 000000000..cf672e991 --- /dev/null +++ b/configuration/scripts/options/set_nml.run10year @@ -0,0 +1,7 @@ +npt_unit = 'y' +npt = 10 +dumpfreq = 'y' +dumpfreq_n = 12 +diagfreq = 24 +histfreq = 'm','x','x','x','x' + diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index b94be6219..78df9ac81 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -4,7 +4,6 @@ smoke gx3 1x1 debug,diag1,run2day smoke gx3 1x4 debug,diag1,run2day smoke gx3 4x1 debug,diag1,run5day restart gx3 8x2 debug -smoke gx1 64x1 qc,medium smoke gx3 8x2 diag24,run1year,medium smoke gx3 7x2 diag1,bigdiag,run1day,diagpt1 decomp gx3 4x2x25x29x5 none diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh index d9e4a7a89..af6b2d76e 100755 --- a/configuration/scripts/tests/comparelog.csh +++ b/configuration/scripts/tests/comparelog.csh @@ -58,8 +58,8 @@ if (${filearg} == 1) then cat ${base_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${base_out} cat ${test_data} | grep -A 99999999 "total ice area (km^2)" | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${test_out} else - cp -f ${base_data} ${base_out} - cp -f ${test_data} ${test_out} + sed -n '/RunningUnitTest/,$p' ${base_data} >! ${base_out} + sed -n '/RunningUnitTest/,$p' ${test_data} >! ${test_out} endif set basenum = `cat ${base_out} | wc -l` diff --git a/configuration/scripts/tests/prod_suite.ts b/configuration/scripts/tests/prod_suite.ts new file mode 100644 index 000000000..66226b104 --- /dev/null +++ b/configuration/scripts/tests/prod_suite.ts @@ -0,0 +1,3 @@ +# Test Grid PEs Sets BFB-compare +smoke gx1 64x1 qc,medium +smoke gx1 64x2 gx1prod,long,run10year \ No newline at end of file From eaa3c3ab880e75a023e2a83303b04896e7ffbb60 Mon Sep 17 00:00:00 2001 From: apcraig Date: Thu, 12 Aug 2021 23:53:55 -0600 Subject: [PATCH 13/15] update documentation --- doc/source/user_guide/ug_testing.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 2fadeacd0..ce5c2ef41 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -670,6 +670,9 @@ The unit tests calchk or helloworld can be used as examples. The following strings should be written to the log file at the end of the unit test run. The string "COMPLETED SUCCESSFULLY" will indicate the run ran to completion. The string "TEST COMPLETED SUCCESSFULLY" will indicate all the unit testing passed during the run. +The unit test log file output is compared as part of regression testing. The string +"RunningUnitTest" indicates the start of the output to compare. +That string should be written to the log file at the start of the unit test model output. These strings will be queried by the testing scripts and will impact the test reporting. See other unit tests for examples about how these strings could be written. From e31ce7e996dedbc050965bfbd226fa4a5da4df1e Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 13 Aug 2021 09:00:01 -0600 Subject: [PATCH 14/15] reset calchk to 100000 years --- cicecore/drivers/unittest/calchk/calchk.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 index 3c340eb26..d669dbad3 100644 --- a/cicecore/drivers/unittest/calchk/calchk.F90 +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -58,8 +58,8 @@ program calchk testname(9) = 'seconds_to_hms' ! test yearmax years from year 0 - yearmax = 1000 -! yearmax = 100000 +! yearmax = 1000 + yearmax = 100000 ! test 3 calendars do n = 1,3 From 83068c7a3802948d3d89e36b6c871aa155afb684 Mon Sep 17 00:00:00 2001 From: apcraig Date: Fri, 13 Aug 2021 09:24:49 -0600 Subject: [PATCH 15/15] update evp1d test --- configuration/scripts/tests/base_suite.ts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 78df9ac81..71b33272d 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -9,7 +9,7 @@ smoke gx3 7x2 diag1,bigdiag,run1day,diagpt1 decomp gx3 4x2x25x29x5 none smoke gx3 4x2 diag1,run5day smoke_gx3_8x2_diag1_run5day smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day -smoke gx3 1x8 diag1,run5day,evp1d smoke_gx3_8x2_diag1_run5day +smoke gx3 1x8 diag1,run5day,evp1d restart gx1 40x4 droundrobin,medium restart tx1 40x4 dsectrobin,medium restart gx3 4x4 none