From d46d6913b93a1e4f435dcdf89f3d79505e0ef494 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 22 Apr 2020 14:48:08 -0400 Subject: [PATCH 01/44] merge latest master (#4) * Isotopes for CICE (#423) Co-authored-by: apcraig Co-authored-by: David Bailey Co-authored-by: Elizabeth Hunke --- .travis.yml | 4 +- LICENSE.pdf | Bin 59402 -> 92397 bytes README.md | 1 + cice.setup | 160 +++- .../cicedynB/analysis/ice_diagnostics.F90 | 124 +++- .../cicedynB/analysis/ice_history_bgc.F90 | 119 ++- .../dynamics/ice_transport_driver.F90 | 15 +- cicecore/cicedynB/general/ice_flux.F90 | 37 +- cicecore/cicedynB/general/ice_flux_bgc.F90 | 31 +- cicecore/cicedynB/general/ice_forcing.F90 | 20 +- cicecore/cicedynB/general/ice_forcing_bgc.F90 | 26 +- cicecore/cicedynB/general/ice_init.F90 | 63 +- cicecore/cicedynB/general/ice_step_mod.F90 | 70 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 14 +- .../cicedynB/infrastructure/ice_blocks.F90 | 14 +- .../cicedynB/infrastructure/ice_domain.F90 | 1 + .../cicedynB/infrastructure/ice_restoring.F90 | 4 +- .../io/io_binary/ice_restart.F90 | 56 +- .../io/io_netcdf/ice_restart.F90 | 18 +- .../infrastructure/io/io_pio/ice_restart.F90 | 14 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 14 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 37 +- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 31 +- .../drivers/mct/cesm1/CICE_RunMod.F90_debug | 696 ------------------ cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 42 +- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 31 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 46 +- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 32 +- .../drivers/nuopc/dmi/CICE_RunMod.F90_debug | 686 ----------------- .../drivers/standalone/cice/CICE_InitMod.F90 | 37 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 31 +- .../standalone/cice/CICE_RunMod.F90_debug | 40 +- cicecore/shared/ice_distribution.F90 | 32 +- cicecore/shared/ice_domain_size.F90 | 7 +- cicecore/shared/ice_fileunits.F90 | 8 +- cicecore/shared/ice_init_column.F90 | 39 +- cicecore/shared/ice_restart_column.F90 | 85 +++ codecov.yml | 6 + configuration/scripts/cice.batch.csh | 2 +- configuration/scripts/cice.build | 2 +- configuration/scripts/cice.settings | 1 + configuration/scripts/cice.test.setup.csh | 7 + configuration/scripts/ice_in | 9 +- .../scripts/machines/Macros.gaffney_gnu | 20 +- .../scripts/machines/Macros.gordon_gnu | 20 +- .../scripts/machines/Macros.izumi_gnu | 16 +- .../scripts/machines/Macros.onyx_gnu | 20 +- .../scripts/machines/Macros.travisCI_gnu | 20 +- .../scripts/machines/env.badger_intel | 3 +- configuration/scripts/options/set_nml.isotope | 2 + configuration/scripts/tests/base_suite.ts | 3 + configuration/scripts/tests/nothread_suite.ts | 12 + .../scripts/tests/report_results.csh | 33 +- .../scripts/tests/test_logbfb.script | 5 - .../scripts/tests/test_restart.script | 10 - configuration/scripts/tests/test_smoke.script | 5 - doc/source/developer_guide/dg_other.rst | 4 +- doc/source/science_guide/sg_tracers.rst | 4 +- doc/source/user_guide/ug_case_settings.rst | 4 + doc/source/user_guide/ug_testing.rst | 58 +- icepack | 2 +- 61 files changed, 1259 insertions(+), 1694 deletions(-) delete mode 100644 cicecore/drivers/mct/cesm1/CICE_RunMod.F90_debug delete mode 100644 cicecore/drivers/nuopc/dmi/CICE_RunMod.F90_debug create mode 100644 codecov.yml create mode 100644 configuration/scripts/options/set_nml.isotope diff --git a/.travis.yml b/.travis.yml index bb8dd37b4..f8f5aeadc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,9 +33,9 @@ install: script: # verify cice.setup --case and cice.setup --test don't error then run test suite - - "./cice.setup --case trcase --mach travisCI --env gnu --pes 2x2 -s diag1" + - "./cice.setup --case trcase --mach travisCI --env gnu --pes 2x2 -s diag1 && sleep 4" - "./cice.setup --test smoke --testid trtest --mach travisCI --env gnu - --pes 2x2 -s diag1" + --pes 2x2 -s diag1 && sleep 4" - "./cice.setup --suite travis_suite --testid travisCItest --mach travisCI --env gnu; cd testsuite.travisCItest && diff --git a/LICENSE.pdf b/LICENSE.pdf index 5be71376b88f9119eb9f3e5df50222734d8d0185..da37344cf0234bb32481f59a2268ef9ae91516cd 100644 GIT binary patch delta 33153 zcmcG%2SAQ(+W>4OJ2Da>kwW9%BMmA^N)io8+S+?*TxPN|LPbfU%t$I!GE%9?jFi$w zQ)y`EKaT6ZZ;$7BpXYu5@BQEZc|X^6Ugtc{V;{$Pc7F$6jBI%+baUKif+|UobhC1t zsI08GV#PXLr8Twzer}#NUXlztw5(Uu@U*q`c5rjmwDh)>)l{NUs2nPl#--9JEGl)= zVqUwOr>rpyTC6A-ExTAz&&}r77#fAbfd6qBEGAc;!jhp-WELx~^K`TE8EI|n8S%bm z;b_GT4&KhT5tnM_5vr;aZCz~;DB2&uX}Gz1+q!xKTr3hUJzE<8#V{^ ztDv6BB*^(!8B!&wlpm28JWus>@< zTW>SPb(&g=8*Kf(&7pEbfV(X~X>a?-CaE|Lp9Ffg-j;-orMIOdgGtVaUA_4GA;)S! zqqCd+AHzv__`}sLy=)OyMFV5)6*>k>H#oT1dabqfTkqy#>AKEPZ-b(yt(P?**V5G+ z`vEpdJSeVowRW>{aJ5%lZDUKgdOLUr$ZIPa`dE1*xVSDwaf91NR|n{2E6L#SHj8aI z%WtqC(0o{QZC&lXw@K3JOxmxRO!Rbl7{GnvHdR%hMT9YBvXMUZ%qLrbEyhc7M(?9 z$w>l#6C6bNqGVd)nA3t=H7zuLoZ$Qro<}-IWv-{rvnC z{OAg9p7x4VE|;rFp()a6^3X%xE5Oy;(qG=yYXNT(!8}L~PX~7tFiD)((#p+;@K%wM z!j*pg$KRQY`>&N;y%fk@DpEfdJ3k9%2Wf-DF>KI$p7OEuv z<*8J88g~Pgu0&xeftFEL{7bJtu=B@wH_r`jZqBNxhkonNul>sa&`l0@0sIAN6nP2* z{%-??tHc136R4t;C=}i-zjgiVBzzwJhiU#i%kO=En+K@yOXDh%>?J8FigZ`T7E(ik zf>ezttC1p<75`NC+blNLN_K9ZE|%V^mhSG(4%Vc?#@@<`e>DBMKZv-qEq_5ipOK8c z!rA-JwFnDxrn8s>a=enWrK`P)l)t=1vwSS(H1nIA< zBNg@Zlr-I}eUQOcYpVMAIM^t$ELj{oj+K=>)y|43Ph&EySs{l9(@l7DRZe?9ka^Znx@#BZJc zKNtUTm4BZ3zgYjjSmnQ1|9`s5KdnDb^1s;sKTY-vI4{$~Au z?fhTY2v+&$3H}%B|L0Zy7wi9jS>^xz`u}c~-y$6d#8jmGAdJCymmdi6BVRJg+-VhEx>9K#s*LQatRr@MTyH#d~ z{7|avbL;IYQWH*<9{B$5#>gkzCQmwfUTRifyYzuj-6|&4$Jq&g`srAG9ryKK$h9LyN)0T#D6+eUH1`c9(P)L>0!X%+mky;_PSR zsTT4bykzlO$zJz%W52IoHmW7(%&BX7c<|Jo<61vUMOO#sq-l<9Dt|D0 zHe+CP=IFVh)6Nc)a6clG*p)tFU9N|U`gL(HE-_V;rY8BiOKr68rMSMq$@g}=ym@e~ z#E6XDi;jMtubFT@?Aeve^>oo?Z%+iL?t8FyLQZE(jk!wqPsX7Gdl^d8t@X|=A3gkn z6;<^9&wxm}^2^7PI|GObBiBBr>^bcIVPBc_UH^Sk?V@}4GtH#BgFjzDcQbPRfZ+l!bNuVfIz z+h$Xom5w^r4Q7Z{1^Z38KTrC{vH`K<1(dPOzU3V)H6`5@rVss#Cd8@-t)OO7b$g#t zWa>sfo4S2*STf<@e9(=0^Tv+TrnV8PYUxxvdDRNxL-(Vb1LDOx$E2S&>YjVD$d_Ix zXJ?&%Es?3HrFo*LIAdzd;?l_3~$n#MG( z-4=iKroBh|5uemyGrFI*UaJ(LpYiK9NY)hqDQVwiCLo8;^G%(fN>F zSb5Yr;l*0pWBCi8zCN$(sY7FKDwG;DS@v0VXp604-tpL=3gO$&FBVU&SRTCn=#nNy z#q#>&(|Sa1uS=1<9e49SkWtmoaiWDIy`=Iri|5x`HqP;=qY)fvMsdlk+%YS67 zoaa=^ZCNZNwPE>zuq+dTq7+{$vS*{rWaXu|Bx5DntEbuz9?o*@FuiYR@o2E)P1&n~ zo#P*gMHOCs_LGyfNcgLn3}#Ms^ZcGWxoMa%p; zob2vQse3=Xq1*5COh-$ffcv?<=Fd4NWNLcDnSQPffrblSo1}^FmayDOOeom7Y}tX^ zSB{Su>Kys4a9L({a`l0UHp`u|BLmOAJ@M+tsHU|^Z?=s;*C%OqYP`3i?wDx<^?9Ci zE`43+Z2YNfXcf zr}60A47UKK_h*(I{&{^+OuX~1hwWWAf+{;}F6ZGKqid%_yoS+)tHWG}eQaAZq}e4q zOP|urW%v)~RoCXLUa@7I6Aht!bc`^6=P|`MsqkzDr_$!|8M{znJGrehV>ao{ao_5~ zs3=sOlu=lCy>fY}iGSIrX?N5c?#Mg)#tgd{{La(;%In+GQ{IWrk}IpO>gpaC>HEBa z2v4)JbC;MJ#uop%I%I6Z>zG%?172e?~>I9Z`bNYy>&M+`=qoqlqgFcf4Vf+CEuy7TQ=MELUJx^N#Ex2 zJ&|Isj2<4WmGD?m|5T!DLcOYsl6IExN^2Vn-|^Z96o%icG?l%SrhO@MX3NIMb(5W^ zo|x($=y1{N%`ovMySCym>+;!Qcjro!w6penHWR;8*5tkF!i%(>$2-D|hUqzG^j-1_ z?)dsF>KV~KdhgpATdvy$C*94L-+wOn@N=)dd&;BUN-wuah?)2NXkW*v6>O=k@X$ zm0`!G3AvY!F(1(;aw}`8)%1w`BYGFConB6SuNPq;+_yIAn9MhWm-7d=8hghSOncP* zHm^2;Hhk-mqT46Lf5g}i8%$MI-8b6$b?S-o$~}yUdhxeviCfw_$-x0LQYQ~vF)>A3 z%ST7CR_gAIQ4fw^&>bt^dT^TL#fvYV6{~8#@|F``(Gk}7GJvtmyEd)A?WDxVNAYL! z#)}6nc{Qpm@R4u0ave=xYt8939XC&iNHa`kE?!klJ(_9%$ofDYGwV))7DKUh;{+9x z5zSM4l8&FS$>3hRAwuX=KF@TW;x+3>XS|Syf2(!3(v6X2bjR-&|Z2xGrJD5yQA?np+i^mJgjc8#FXrE7Z@VI{b*rUbLQd`8L@9p`p z!G<&Z)4Y{MPA@|y#RVml9n1Hbv{1o^Vx=N%QF>(h{6Jz}Q;hgWmgyXc9p|D#&#f!#Z?E6T819%na9BTbvs0syuj%`% zy2LvBAMfLLXm^%X%yfFW+Eq6{c4yri$J7~d3kvMF)hv$}uXxorv+i_Daic6J#Y_FV zuvFV6=KZ`kQ46Ngyl<(@cdEGWp6z0Bv%JhZ`FsjB!!F|N*ae?kCrnLLFsjqYO8vf~ zL?myEcfc;=9nawvSoq?Wu}Dm$!~Mq8#Fu94{ICJbXdI%eUI1X0;%tuKFKSyVlsXt7rMzr?6J9H)_BNpcBt&> z(RIS?M%|?nXU&_x$=1#0E}W;u2{OO8pulzY7h#zR;?uTGoFqKgoB73V(J0fKhD~?c zI=5Rjlzh9pXwSXRjw03xkGbLpZ5|O}=M6T`I&G{VPq{-3Zcpla7&7}q#oOqQI5F)tZI@Uf#AYt6lBfB$;?H1LsGpH8;4eTCJ%ENoqJ;AkP*QHH{^y6bgkrJrLy4 z+&m?jyi*jxxdRNv;{`l^pz)3k$g>S&Gm06T4a793!NCX()?pB4bUIy1x%cMNG8pDet|W^$f<-mMX-KePZ{)67TuB1= zM1BB>SVm9TqCGbGtevW5-ov2nkWYz~PEvIyJf0Cc=T9Of^$5icB$BP4} z!B7$VNG%#1!2$AdIVzoM#-IT8=+K|egN;fD;E?1@APd_SkvJibO==JNsYGY82EenE;5V<&``20}su zDItZ84(J53(4n0Mq@lrJHVPhtNunPY$FaEJuSH~;r!hfY;2UTK49KQ{qF~d37f_8rALM8l%tb~52BZVy zk^O=3KtzG7C`=lhiL%Y<9Hchv54nm1>H@%LApwvzK_r=fu)GXPf9 zzYJIgm&83XfaT~+*gFN-3BiLh!v7nE1(g29UVp`-fG~f36MwBB`4*7=k8j{%wE{TrA3#uWshhbI(&8u%Bk5CDlPoxuWi1AL8j4AyU& zn2!U=*j_7GJwBvVGbx}HW)J+s5JaWfLIK=ITOiE;cXcBfM@@3G3>+!_7mti zvNP}k6Zn?g3Ggkc9gyYF(m{VFs2Q>i)C?Q61uiIW zMqncomF+@su-@MK=RdLme#6f{lWFFgz)(`a)4{1o<%9@@eK1IgM&tsxFfED{7`9T z$W@3>77!cjNTo%GD>EdbVITu^K9*TTp1!FB@A5zrAd8u&B}HY^E>6%oh)5LjG58YmZ1PH}(GkAX|`)h81? zJto}sVZwwoAOxwfaUnL>9I3{}1zcS0vA{ja+~so?`p0!;$^H^3q`a9(ovq{gIyX9-G)Ag>Xzf#z)Rg1|bViXoBB z0Cx%;40AS+0bMiz6vT-QsAU32u-P;->NVuiy6jR^hVViGVUiAQkCfFaRg zqjAl-upKTMCpySKmja#}uK}c!1Oqy-p&m3HEXt*D1?}L#!$9=-U{bir2mioqV;^ue z5bX#)*njv2@X2=Y7C;S?eZWEBqMFBg5JE0&lSbfR8u%%EByvGQxfo0V61gHE3sR5P4hg^oDS-=w;GAO}w&DC(2K~=PbYcU9 zkX+Q?*Z?etT7XKya0J+v3&PKV8Mq*GTu}D>2ACQclWYLOaKX=K0uI0hgSY{fhMAG| zNSgoo+nftpfs5=(Abe~)O4nbak_!CPIZBc+7$TBX7 zdYadQ$Og{E79c%5c-#&Jga<^5tVCJ?7x2aa`5{=u8=&w4?-f)56tD|3BOm}Cz`P(iPykq{s4;MTDvfPMr7Ee!L1nv2h%2K!2AZ74}hHx=?#I3|MMI2AN&fK z3iKjmNx=O;*@D}*0$GP9)P{7>gs8ls00Kk@UC09n6(SunO}sYHh*Y={%Wnhk7rwxP zljFc#!575h zA@~vi1J<8P2bId3lLJ>egH9;;4Q%vX$lZ8LvAfOrmVSt+Dx4|R~(1&Qmpnz={Wdbl%bgtk5 zo&~B;jAY<}kdR;46Z9Lu4QByU$8Uq}FhE1`+EA}CfXZYWfi5C^0#(u2K?&ypLZelK z0{K9F%4;NhphtrBNNEO88f_I6U{gTW->e>F%aFtnq=L(Z@PlC#*fU6^A=Hrn;I~1V z;kPzmcyyY1!`PrP`Q{O7aUviquZe@Qz_XlC3!7j7S@})ik^Ip_rtLuZNKip?L16>X zaAhA?0&>Cwj3d}NC_uJN;GRJxlM3n|BNtHa;86h)p+G*sVn925!Eg*A`E4*GT4R12 zEQ~=fzYS*r{lROaQq4HTpI7?BG32fMfBiNGQ-iRfr-Ylq-~b+=P{1dE0>Xyg60Z%a z2qu_wej@@$`sO$g*bE*#X95a14N#Xi5ZDa9AQ~Vi1vY~(o=X7*oCR2nlsG1uK{9Ly zg9-)giSaXvKNBeGw|e%74fU3J%o3dMGatE(;tJ*dOQ%cwl@7%!t7<6(e0z zWii3A{}=a!3EmMEgI(ULNOp*J`2)cJ7mR?ZQGl5s!2F(^KbkO0MrEPn5A=cp1Jx-c zY|%SH`-!a(jV$dabbb~3n?wK7H0yt z2WJBR7an|hWg!Y!Kvj~mEL6=HL-Qn(h1#D5WF;jM{u1G@GDy1r=mer?hx?+_a5bbL z3rI!!-&8P1zgQmQRA5k`Jo3&zcyRxz9#%lYKzz(2F2w79IE84bk?NqudGR+{K&Vh# zvp`#;IfVkozdXN)10gD}KgPk(0Z@)Yh)EX6ngf$Tv`kuED1gTYi_<`*p-B{&VqTn% zkr&@gBN&)}hUkN5%Xv2095V2Lel`Si$hcGtnMqTCo-u%f^WgG=Hzu8M4Gb_z1p#dU zHcW%8zy<}5sahxi#@WE=xFsmS2H6;y|;6JQ^cn^IOKECixZjY?_YerCj5`6!y|3fC1`Fs7-+P|=gQ4lTg7@zeBU*8}oLj3NfX^@E{kv^ijoC15bvI{tYA--~sM1Z&vV{NM7M0)yTX7xhl{Adc#8Lt{}gMS3atELL7A@u`?g&OPhoAgvI9%aXlbulc@Ct%zkOvwC zR0O|T01EmV6bM0h)no=9_X8M(2MG$~Un$_0@+L>KK|yOoP7bH8{AvURPq@iyJmV%I zgm@3~t^!cF0#Jahp;`b6oR9E&ga1s!Bm+4KBpG=Btmk)Nqi+9Kl zXqpKAa-@v{MZyMUgMOwUQ@}y>2dERgk?H~z;3N>80G>b@VmgZto#6dz4z!y{J%AkB zaC?F`A#e_UH(1=JOGgxkQ@F}@_3Sh7?*yOE(0Vf8OY+eEM2rw(@2|@uF z7M)c%_5%BZK_omto1raWfi|b{G%)r8X9ONVQt;}afDgPyc<>Yx z6tE5KC#pm!05o{Fh1?7L`6_;aC~>K{KDZ_{6iYlKfC6>}dE=nP!ZT1BDbiqIpa2;Q zCf6JaxF|X%n8}9{HljeI!DV5djs+SLV`V6iZFt&1w&Btc=fT+y7RdF%^C2364e3xVJ;sStYV|xMH;aY^K8UC zasnF=PtYL1;}HoDMd1s{iM_`^n#%lI|7Em|0GL5c}$y;7=+sa z@C8UkqXGp)75c&?Dgm+Z#WN&OV3|QI0Gtbq#s$}kjU(`|l$@44F~y@&k}vSAl!Hnf z4I;P}^{+;RDGBXo0Ye*Nv~xXav;aIJ_f;@&u9x<3VoV!B@x-g7I#)A@DQ| zGI(GD-QWxS9*hq#27_uCi)nETsjx3z&k?9j;6Y5g;9lUzOu&5r4Z?x*FX)En9LSy! zWRcM$x-%rWq#KFhAdCY#k*)^-3u8%F40Ctrk|F!R^$C~{X@!Ttq+H-BFl2DC8drhI zFfxJytO88R#D4_H01GyO`AZx`P6Y}MLEz=Gfhj;jNZbOSV@8+>ej>64nXZ6CbGQ@% z_{L*jyz&JFxI;jPOMF}uA&j>m?}Y{6KiC9jvB?AnXdwoZ03-ubV%`xl$j}H}2ObYM?NenDs04xYb~sWDLF&>u!4S@F!5hBa{T3kzVdh5;kM1fw4)pLn(osfrjDvUZjT! zgy&t~KqrsKu_y_c|AJ|NV(>s10gZ4<3&9bv7gRv%8k-UEV3H74CPchkxZ_BHEy07Q z9H0RAFhDARU$6;~4?i+Q_J_0wR3IY30RY~IW^n!K6aWIJBY=(I1E50nL%}eH0^&$! zN-n+=>GHCa28}HUK`GWUIN+11^)*= zL2AiHz%qOZfI$(&NRr=%(|`@-4}@v(;F@d$qx36x4z(}|oN)v0V1sZY^Yfhd*0VHAQgO=mBcD(Y6%K)!n&KnB2C*&094+UHX zSccz*dm_MN;Wy&apdU$yA#;yke7Zn}9lu~nFf35OX)sNLG()zB2cU-6hO?l$Bim3b zU|>m}2T_sL@J=@=RdA^rzd-+?Btr=wz+F6iBX{AoZXUjoyC4%tiWd|>JW!m#fWQZ? zjxH$h0u*o()P>Lv1x!hR5TjfGIAj-aCeR6BBlu8HBfwF>2GSTXKsxY#H#`L0fqif? zJQX2@8>ImkhMWav(0Iv3D1emVny?(4SzXk_jP=nB`!;S3P_ z@H9SP6uN-wg$L?s=u1Gz2xl|Ege1isK5H|oEo>;$=ERMpT1E(zowaEqvdfB~QYf8YT)ra}A97F*BS|MrT z(1wwg2zUzY6EuF`nKreG(2%HkFI8qM& zBNNzyI}|t_dH%yIpo@WP!TiXtsN(Us1%Ct#aY6^Zk2z+%ACA)@5Xd0-79c>tG=d2Q zZvnuVT85vIgN1;**4X;>*3eNyu3XFWXWF#TMWNd2EU<1{?3&o<+n-D4)OnZYz6*=nl}Uy6gK{O6a2;- z#NW6-_-iLicWqk-`)%HUM;iaf*1RRzlV^gy!6r1cm>Yw$ zNU~MS(#63!K$iURHc9yPHc9g5+ZOZM9Gq=Yp^&TLpF^#+bg@+={_*$Tu!|x5#G1GD zHpR908&S^WG{!t2;YNevYWO`l2kRBC_RhAF6h%Y$^DQID-u&_RR)73`mZAxNZy-*; zVFq?i2vGCSKUF{_f2ct4I|YtgCl4P(88$p}*vWtWvomsc|M3s?@D3K2|3e69e<4_8 z{pm0FHjdqJGJpEdR=GC#1pry)^ICJ2O*JQLR=8_a&p(iP-b!!O$&Kq4IzBjlX}*@o zohKTbJ*QoqdtmJ4fGEd`59eeOnR#Iz8fU_c4zIbIQtIDqQ1yMpYW-I|u|tHPUF$&S zv)E--<{R#CMs6{gMC`xxEn-2!%f4lg^gqN%A8fv^_jR0!qWuh;`iyjyxg+l>EWN?; z(%86B`bF~SqbtkAzj)1lXRbIZYq0FH17WVXljcL$`n^;B2^?n z*-5PIQY9nWtT$E4raiLqk)vIfSl9W;L+_Sxtsc(Y<)Pj9vZ_YZ=Rzgz`JSjLc1wFo zKgEAueE+CX!^^1&l<`gmPhQ^HF}wFz)+I%kq)mC^_ioINHlxk3Uffvk8@^?t>Z283 z^|JTsz2|IVeP2HA$n{ms8$)Af$wsfge3l3=bevN^*G@@%p4Y(=+Jx89)srOZnR5-M z^|z0sty5V4@r~4+!62bFcZKx$;r3Da)5H6Z_^VqUa;niwDb}TDK6}>Sy-#iQRw=u! z!%uzk83@PmPFQ_nWs}3yIp@}RuQt)#VIteA6REs7XXD^)R?2|1g?FvboTyM|)tzkahuHx+ znH~}{1^ad_-sR`Lvr%ovZp{(aksSHtf|H)v+Y_riEPRF@5576^u+Wrsy!PhId7jfk zBrO_V?DqV^y!X7A9i~?3dn?w7*PJ8euOMP* z@|twxY>8>c@ltB~t5x17!e5WQr*-7a{1M{u=i_EBs#$ryKy<12^z$n=PtLG4=B`qR zC=x&EnUi(l9C3oCbo$tZBA>(c7npBO+r+kfdz%_q0=QGnsR_+Y?Ps^@wI;Nh*T1nv-Wgeo|tfqae#Vi5pDg< z*V{%fh_y3hS&PdjWn4N@nV9x{%lP#6$}3++ekkcZF^T%zkeC{*@AoDC)500YQ@PrE z!nCPJ{bng@9r$J?x?qjm)@fntDSPxUX$475IxzlL!i3{fXyyth%ZWT`uccm>F7-01 zos#R=C05y^I?y5Jz$NrLA!&dc14?I+(CN8F#mJumT^*mx-9fJAt| z@V&5Fl?~StDFJIY)+Bm|5wAyn$i3omKZ*M*?-zD?u#DsHRucls>pRQ=q`(o6$&t39u;;G{oWS_^z z5w69Jv)9d6H+da%ZIS)rSt0L>w+|5o!52(Zd=eBIm9HMJj@l!eCAC)SR9l{2o_E&n zZ4xySn-9yT2ua&G4y;V+z%iSz8ENBSi)7MdPWZS^?+d|}~;_shWXxMvxLtJ)^DSUA7y7E&x> z%{4k`w4Rv!C^kHok-3!f?BcFDt5;8X=CVr3@50de1Dsq;Hw_4=TE>aa#WPvSwF|q`R&S3zcvy6wsN}+h zqdeER`|mN<9=1&S$=LY%muVMnx;ndzjg>8aU?OAiaO;jGX`9BccUymN)={0$pG}4? z_2uWS8;Uw$6!lqaG;#XeRH2%|=ROjmiF)O7L#;irow4~ny>t4{YTIX|U6Y;_-6S%~ zDq@M;hdZU8Z-r6w3&)phXeVSJmS%4{kbU_6&Q%)SpM$55+@HPrr1z7@WgoTt8oyqW z_Ri~_n@s7BbqWY^f7^d^|C7$y37J}EgX&T>AJ28#Nu{jG2+z=5Wk!q~5I<-+@u1L| zn*EEMv&0rVyS_~kD;Gbw$yte-u4=~T zo*%`pFE7m%dpXs`V8K>q?_rb1if_R}3sZv1`%hnXvX+ln(zn4_>3ZuMo`*g&Iu5HyaVZvh>Eo#wMEfto@^E`j` z>l!(Qjb`iDF~8@|+0{3DH#@J}ds0uqimpl3OYEPHdAYUZvk}MnWTe+F*~6D)gJN7V zlJu|mQ=iINr(V&J47L&XEEm6e=1`sRh^(x@79#gYw_s0><6`my}~jVUU=@&x*yxVEgxuGyJXVj_e5*__K1sljY)AS9y=cp+{MxNp4gYwRNtGm0Y@YT{)UC`ENWbbYLv(SFT{c(!!S{^vGVGKyYoT;Q=OY~0J- z25n`-pEh5M=jOb<%?_0;eXX?a%rS28=#L*?*}wXDz2)WWCCR3l<>vfM7yzRseS1LKw)j&xUhytJi8RjcIIk@h85Zh8%Bibgai7>*E6a<3n$!`LSm zyE}Hu&QnulK5E8ERo?8=8{FL|{k5gE8cUmmnwuTWgQcXM4G(R-XxQta2KT`+-4pC&R##C+`j z`C@I)&3BhS@~tokuMNE-RPsVJOT+*1`yA_UpG4CV8qYl0eZlgkrMr%8Ez4_4>{eab z*d14gRZ^m^jmqyoI4B*m!gpWCF4Orp8eT?8Og1;Kqn5o}Io>mVx~;~UZAVQWnQ7)@kRh?XToIoqW;NaFsZ~zFJy4N9}5%Q%(H0 zRa;gY7(}nXA-As5z{ZeR@9d}i#i7U5)7i)6ncDHLgB2Rd5vDR;YA02@21@()HjZzb zKA7zP&d@~r;7Yv?F~^mslipwDsF+q>t6Ac5w%fWS#QdA%p@5)G>5Cf2%!;rXa1xs# z>q?aw%Z^!_Dw!GoZZ#3R+VXVtb)EZzvs4nZlc+6+C=(^hdQ@%8q*vc7DW2aEck14| zJ8^z)eg|6@Zq&`#e=bOq-L=I$tSR3o(aHXcc{^p_X}gEBvaY(>_m^=i?%%gzNAGqx z68kXQ?n0??)9bgbCPA6j>sCH(5}xP%{S90B^Op#2xmrcrg~ph;W#Yt_&-?e@xYwbQ zmOQX&+#4EGrS4792i1w)Ca!}D8@K;ZZ{552S~x=P{n+Cxd*(#K?X#*Z<*cs$T7XK;O5pcdhIrEXKmc@Lq2Vebqr70MQi zijF#avP!zMep6OW_t6>eKkUeVIdrdgfoN`T;|tflL9uT|hYyb5X|`PG#kkMQ#fZs5 zGlnY;m!Ii0T&>#4MzVRq)ssouN#4gUz0z4fPHvBDn8h(qkMU!d$CZ@7cRRgKw=h2P zkx}9_>*gnKn6CME)(2MT6ql=Sw~RaNJLBk$<^>@I$`1~Q%q#sN-6MX>lv84@_i@ip zsR5H=gL7@B2E~rQJ7#cAe8~t;O48Z4iKXg<--@`s6?e|rkDOARS=6{SXi`vfX!bCd zynL%F32n7`2bo2Cir(lG;p3m$zLH5lHey-p!G)3e&#a&4<_IJ39*a*hVOZiHy{I)w<)T)&Z*rf2R?oR*aQIA7@1 zV%i)RLikhK!*|N+Tc)~Botl1gV6^{hJ-gJ!6kYw`q7dx^^^(#1{ExZOrrgix^gP%* zcIG?BlD0+CHO!jbuAVzOiFB_Mc|mXPi{F|OFmz`3h0!Tm3xrF#6Jzp&M7raOy&g2J zHJ%jv;QbBD{<$}WBwh{^X%2LrWIZYFNbuQDfft&VZy?U>9@aRQ!rWcmXLI!A&e$P8 zmubW2o*VtC|Nih8p;N=21WhQFf7C15`)yp~gvLdU!i}Nun^{jA4ido?m_8~KRKg5{D(8b3FZj0(+`^Ur>CR~`m@qJ*q{ZTKc z6LPf`jq52bGYg6L!!9?(=rt-WaG57Hpxi+}c1)b;{c*cw%!Ql#?*z2^f27kQ4o(S( z8D(jU*pL4+elLsO%EsWI;mXF($2erRUA z+hki@revS-)|RI=i)d3je?AQ^6E-$5A3l)vF}Qz(^uj&8)3s&yOt#L=-A2>19TdHf4&8k;aETNtPWuaKDITH83BOaBqy z<+9PpB75I<;ic_?7jwTYNPJurvA0#HL%;Q6sr3TmZD%5-lkT>C@=7YS@;e;xHoL0t z++x>F$v#DQA0M(Ud9JHOqm{|Np1HtRwPp7krMFc*H}$)O^iFWE7AQ8A_0Ksz@#0gB zULwJ+?{@jnCaXdJtB2kO-?Vm{pG+~nvbjTfRpDb*Y2V@z9YUG&dLJCh9%Jpb`}r3O z2Nza;_}vHIHubBoAK$FVyk=qb&hfaS-P^)DHmO{j&I8KPt@mY5x<(wT$$ao((9>#z z__tg8d&jf}9?fHU?Y?#Rtd8dPk3H!>*4ITo4LD$|Ti!*hG%r!E z%1u`4t=x9#naIy2kG);KDo*O0`fRF1pvBJzcOq@FDyeTD=FNVaG%>JzK>}k@Vrk00 z-O^_m>pQid&Auvm5{s-vVWbl$7w9swcDivWq?aI#ojZm^b%SxTVzjb7@t$`*Zjo#_1Y|P*C{WaHn%d&9QvohS~*Q$iQ zD*21|!#q+vJx7JO5~+uLo=CLlCry2LgJwNX=4>&cZ2G;`F-Ub|XRKUI8!gJohqFg5 zowZP7>WwqO1r51Pxh-bx7ncVp*H^y`(Q4Ej9GR}_8}k0Z=d<}uwe`JsyN!KWPqTET zmVHj&_x9B}|EZrvzIm3ed3COLnL~M5YV+Xvd3F&Aw=b`Kzty4S7NMr0Gu>Y9-i*&P zTP3_Bdp;Sj=>PDoEO*U|%&Q#zDF@>-vuDMLi1%+w=>M87)bjF&W}~Ruyzgf|w}h6} zrDk3f4Vd1s=2&r7s>hk|cPsB-$WTqmG$?x)Gokj!7yPZ{6t0e_HrCcFNPaZecqM?nN9Y;{2U7 z8>`|DRf=Y7XNtuC3<*`0398i;?H4~W_O5qI!->NFO7q9#ncrx z)};8K`!1HL<|Eg(K+8VwOUb72nxNcsqc5*tKlK?)`fOx(!N|VFJ&}!*ZcCIb8@)Na zUfO`W_DJ`gmX$wrcTV%3n&~%kWz~$zhT6Nt1&x8ZepMMai|6V+9i`^ZqF$X)TCG?x zMCi?L&tqP_+`q*rX@jjwa@&?v@$_{)!#(e(&!4Ar?a|#iRPz&U=VF>#ZUx)#Ep970 zTkCuE$K7WlW%MTDHp9V-Bfd(CoZTbz(zK~OB29#oGvlRSGP_)&+gC$QxY^jKNUxn! zFHzX**qNfgr)QI`T*#07_-O+J8-(J5Q~DtPqfnl7EM3b_rl&^ba=XOc51D0h>*6K_ zghbmcTO5(6CT2KSqslV({I}L+o~Lrun~Gg5uQ}>`EErfCHd2goBg(q+*|oq_Iq&iN zMP}D^KKK1L^Gu17XklpGK9&OUJno#e%@`k{&&Cbr3iXr~K6{HCmWe(0XgfLnW0QE% zzP zrS`3zeww(+jtouFRX3eC*yz9ZTp!i-wxQGgQ+Hh%3SEX)Uovbb^rx!PPxYKE=d?6z zY}hnAcY8$ZvE2-7*O8KT>;7 z)5$VISpVqwvWh)F&l>M+*$|cBXnjJa$@H?kY2c=nhrZVpwMyI_wP?HkQ_UV>+TJ14 zvX71M|B}b;%T@ch>)g=u-SsDQ#@-tJJaqe$K<%&G$1CPPzPVH9>Kb9+gnJW1wW1s3 zZ#E4ya%h@86Nu+8ZUqjDOT1}u{V$RI3`j_f5`a3eug%-xmvlmX?B}&LooU4BS@Vp^|b@ty~AXnekc&2CXU8-EpoNhA@iNWZmt*(^k#R(#ATf8Rw zAB&IuBuSE z(Da)nrS2c+?5zA^R5xb@;qq>1TYd{C+@o6O!>ak>Zd-OPCl$upAzSHsjF%pF#=O)`=|psbG~ovh_tMev9PR=Tdbq9^y1SQ;y1X5dv4d+ z>uK%Fw+R9V=6F$kPIDyTzVXTQ{F2PTw!nqbqb9GPwawFDz2vdT_DdUn%+J~?NnBhw zKj*>|hxyi9J`E30j8L|^J|pjg)iNvbc=abb>xHL?YA%{GO)JUwiuch+pI$gD`=FkZ zKIyu=Rjko8&wiD_p3um73lm=bd|76r+SYt_(4(jFqe}nBlEmA!1NVhbSDu>|bH*ln zV$O=%EWZvyxMk9-F(rwrTJ(L*4+2i??+_*~$<~`L>9%g}wX^sdlKyH_-j>2$gxHQ( zO^ze=rou=SQwH-Vh`D ze~1e0o3=ijpbBOB#NN6#GI#qMv+%y8b83m)d8b2y_6@sVP1EU;Yns?LyPe)%d~T!u zf|W$%8##9S`+L{lRX&`03F6dXpk5p;OXlEh%;_QK@P56LRtTtyApPOoq7%kL@MKcV8ji8&vnzSMF)+@U6EHY85ibh$)Kc za_#E~$RJF8Z# zn=G(hz5V^$h}|Z)cZPfY{QA}OvZ2bHkB@7(5f{@VO1VkR<%Mz2oeo>CbPHT*Z1HT% z#+-YzOj?N4*1=LUi=JB_`|c5$Sx0`hT6!cI{;0ecJZ#zeU>OIGjG0BV-lR&#rgHidsPp6}YT`&CcyO@;ZPyB=IS`{{Xm^v?F$ zT$|AMgA3Y(L>tBTCUBlehKgG6|9Q--N~E%XlT8+TGZZ4Z~%&~E)U zqO);B()UX0#lf?WRpTCQA6x&$H7lXqrg)_UC1l6U`cG?n{VK{oY)h?SK4D!P)R~^} z(p9bbtc~X6J~`R)k_Vlw!>{YORh{cNclB|X-;tJ?d9)RITMx=P(TE+clS^Jt^BCu( zyeCy6Y~F~^Ldt%pQVyxwpIVSJ_Cw*@c`NRUt&MkOemJqi@$zEV=}pPaE-43hS;f_A zpW9!&@>1M5dCqK>&>auf;o602}WIF=`G_wZ26H{{SOVb6?Y7dcV7B+`Rv(31@xZB zkrVsn+g*+})WBiswLS8?pQPq;-&16TG)~IfLdQa)nV#_WqW;vzfMFQi&_ZjBqg z*T#dmUv;T(O~lurTAexLPphPbH(2XG6RFtgBknt?|M^Qfuf>NS#3bJB*_S+(Xw6>v zRrbF1iJfx_avZ&1(MDUF%9gcC%$U0K)~UEt(X+Rm4H({YUuN6sGMz7_x-nPVUMM$d z&2p>M=YDQnx^>F#u1=BSa%BU(;Z?4Oq{j{!J9rl^4U1oA`hH%WX~LWbeOJumbW^uG z`ArvZqwCl9(F@x3_l8f0l({0L^RV=%l`aHWzY5dDJ{c9r`yT4_( zIolrZ*ca^-%Wiu-SiOic`%77HXH?PA^Z8kQ?AO;1afQ30F20B;zk7XI$?p0=TgEZ! zBI1*H^kCh)*O!*lTTfQ7oZ7R#$iZ6HglOR_WC~{rw-EbM4Jso{YL{N8M!uG?uMg={Xx;aI zR?sR9xmz}yEp;|baI}vx&-3qP6`3$TWXwq4eEdt`8Czm#76)jlu^EPLhZBW^H zt2d7??Y{GQS)H>{%97dk>rbW3*>Hu!n0{*i@Y%XGDzDO>JaO0+yyEN{p(SfQbEa?G z$7l+!%-}c?cHidavM)>MF0CF=OJ?lM_qaIq!W`YHi_$V*SOj0|(&-#kx_YwG@E&&Q zK&i*9#*cR?_IHD}m@TupcK82j?7V~F+TTAOac{6}LLqW2X<*@RdnELMq57GcA65hQwal33BAMf)C^`DW&u-#@?4nK|c~_w$}PbLPyP znKS3S-cR|V#7kIPF89>VSnq=tmes4!!aW=bR>HAzCm(pWA53)w$e$0x-OFtB?(-k` zOoF_-ms>bh-xQ(uSkG~qv|zXwWslL?Q(V6;w9YI3s0fyPq0&U z)-6P*3wPL`n=>MqgMYr9!`C_ir>LP%&(-GE( zrsOrhQVCw>9gTsVek5_HONR^74Rah#no`YxY7Gq2`jB=Q{*vj08OsrZYEbL<2~*I+ zOae=EsZkLv5e2gmKkMr$9M;QJY?VLpp(hv zQSC-SIOuuc+ltVyxhk8#Hc(vp^z#Vvta^z1YrP1)^NJtd-rrtG^uH#MxQp9-U4?Lf z4P80nu1NH;RP8Ehz4WRDpFUraCR%n6x=i?EX{r+g>g(ZXR8sO>J@r36ElUrJDSfMe z za>HQ!JfSL6&{*c0v;2+jUhFVeWTXi6*h%(%mV$t6$Dy)`q%P%AZWQxjNuymf1|El zp)u`w+;7jXdd2fHBX3dLlbN*H9#B-16&)9p64T*p)#(b!h>F2n_c zz}0adLZ9t=san=a_Vq5nqT+jXdbGksm*{s=hfea+3RSe@CuK0-2?%AH$GL8)10C}U{zM+0jwHz29 z%Dg=mV}x_4dRy9?^vir)1S9loqtVk9r@ZlRUvpas8ZCkNDsMnYe_jhn4-?z8tk26#r60 zrBEfSUN=B8V20B6!K24F+26pgM#icsoc(?*E%=YdFgwo>iJ|4BHEaf2o_#}X!}$@@ zpHmEo$3`SR@dy@II?Q_kM5ZQV3Kc=_ZmhBmN&6;wp@xsV7ibgAH{d;=*@r7vtdfBH zNRh-ygL?vtl5_#CUU%MtH%epno*qBot9Ue;WFJV{i6>hrd%g*SA0294xJpe}WK~GW z?6m(RWkJ>b$dT0XV^g8;qK?kKHCCdEDB*>wOaXIl7@=DGF>|p&cx?hzR-5ELIedUF z2~;s!*0e}ty;a$?xbEMBs^XWP?GhWN4?k`a6|_z2QG_-^1q|HcVqh6}R zjaE$~TrK@4j95d4)bV1q!Z*SG)$h!gH4H{ZIMQDto(x78u|^z`M|M?DJnpmczQ~#g zTDoxjH10M>sNKgIv%9NblwFD=>(?`P9453_^Y`+|`SgeamCus8YYcmDq8Db=4_E%0 zojrMxYJ;8ttAf)$s^o_ZU3{tXjZRDelcHDDfJ&H4l)S@E~7M((}H6kMr#?)^M8@JeFO?tqMAm@%h^XA7@=+QG!=CHIPZyaFM&(3Hb(kT zGc?u@!D8*sS9;Y~oDNj}(i0k(^~V!=-5rMDD(j1%%uWieSA_IWw5FGlO9h;AZ`52) zBK@=Dd$})%67QFntQt4)rh zs;TGJkP~+-OzS?d9T-{;lIK~Lf=s7g#^r~+UdslCTU8C`Uaw1@jHX0W4%eC~<-3B- z12)bx_bSn*3h*QmjlzPCIq$J+tkH`+N!jzAW{L=JwvS_QD|gm@)~fYXx$RTL=169V zT1Tq`yc26&U5VrPpoN8xdDcc^k%yhs-MfZE-rvK-(~G~;xYja!d5F}$SVX)P^x3`K zXd08+q%G{Bbm$~L8e8L4Gz@bkFr+P}3jRBm2GUUzBr8Iz@;54MB&KscoAmfrIVt9wgx_w2SfY5l5x4ZUJ1Awr!fez{L%@ zQ1Rzs_xPz?8Dw6f=jzVWd2`YYh7VCw|sKfIsHi!()pVT8Qv+VEf1BeTkSHbHX*s@ z5ruPjEyEGIq1qC)FAfH3JrQPxyP6jRRZj;z@W&X)aK|jJpfi?98k#4l{)lSfuoBa@ zD6P+U5OPou5ZK{N6sK0}ltgn~gMKUFM=z9c>@CqmzrbE!{-PrNT&OcP;?)sR>9Q=% zPWu!2s|IYWMe3GZzZ`21eO0)`8rQB#F2b*=g6)2LhJ9aEERx+S@Y>Qy|SOk_*O81j6+U zEJouFNB`xA9Cf0`FcPnsGjowMV&b!J3ZDc%fM+gosyr4m6k+R)lsB$A$KE|E(Ulp* z9CX3(v3VXN5o;T9N*nUW6ph#-cq3?5F^|Mgh?N#-kt7Fo`Nk;wwul+K1o2k4(sIGg zhuTiCg1hOa@yHfKsR>J_2bhJ<9IV^y3>D`52`J=(#hoWe#7g5(sh+cz3<4Sw-Yr+` z?vfitR6FoZc2?u 1) then exit -1 endif +if ($codecov == 1 && $report == 1) then + echo "${0}: ERROR in arguments, not recommmended to set both --codecov and --report" + exit -1 +endif + +if ($codecov == 1 && "$compilers" != "gnu") then + echo "${0}: ERROR in arguments, must use --env gnu with --codecov" + exit -1 +endif + +if ($codecov == 1 && `where curl` == "" && `where wget` == "") then + echo "${0}: ERROR 'curl' or 'wget' is required for --codecov" + exit -1 +endif + if (${dosuite} == 0) then + if ($report == 1) then + echo "${0}: ERROR in arguments, must use --suite with --report" + exit -1 + endif + if ($codecov == 1) then + echo "${0}: ERROR in arguments, must use --suite with --codecov" + exit -1 + endif if ("$compilers" =~ "*,*") then echo "${0}: ERROR in arguments, cannot set multiple compilers without --suite" exit -1 @@ -355,7 +393,7 @@ endif if ( ${tdir} != ${spval} ) then set tsdir = ${tdir} endif -if (-e $tsfile) then +if (-e ${tsfile}) then echo "${0}: ERROR in tsfile, this should never happen" exit -1 endif @@ -416,11 +454,15 @@ else set nonomatch && rm -f ciceexe.* && unset nonomatch set dobuild = true +set doreuse = true set dorun = false set dosubmit = true if (\$?SUITE_BUILD) then set dobuild = "\${SUITE_BUILD}" endif +if (\$?SUITE_REUSEBUILD) then + set doreuse = "\${SUITE_REUSEBUILD}" +endif if (\$?SUITE_RUN) then set dorun = "\${SUITE_RUN}" endif @@ -429,6 +471,7 @@ if (\$?SUITE_SUBMIT) then endif echo \${0}: dobuild = \${dobuild} +echo \${0}: doreuse = \${doreuse} echo \${0}: dorun = \${dorun} echo \${0}: dosubmit = \${dosubmit} @@ -449,16 +492,30 @@ echo "#hash = ${hash}" >> results.log echo "#hshs = ${shhash}" >> results.log echo "#hshu = ${hashuser}" >> results.log echo "#hshd = ${hashdate}" >> results.log +echo "#suit = ${testsuite}" >> results.log echo "#date = ${cdate}" >> results.log echo "#time = ${ctime}" >> results.log echo "#mach = ${machine}" >> results.log echo "#user = ${user}" >> results.log echo "#vers = ${vers}" >> results.log echo "#------- " >> results.log +EOF0 + +cat >! ${tsdir}/report_codecov.csh << EOF0 +#!/bin/csh -f + +#setenv CODECOV_TOKEN "1d09241f-ed9e-47d8-847c-038bab024b53" # consortium cice +#setenv CODECOV_TOKEN "f3236008-0b92-4707-9ad5-ad906f5d2ba7" # apcraig cice +setenv CODECOV_TOKEN "0dcc6066-fdce-47b6-b84a-c55e2a0af4c0" # apcraig test_cice_icepack +set report_name = "${shhash}:${branch}:${machine} ${testsuite}" + +set use_curl = 1 + EOF0 chmod +x ${tsdir}/suite.submit chmod +x ${tsdir}/results.csh + chmod +x ${tsdir}/report_codecov.csh endif @@ -734,6 +791,8 @@ EOF endif endif + set rundir = ${ICE_MACHINE_WKDIR}/${casename} + #------------------------------------------------------------ # Compute a default blocksize @@ -755,6 +814,7 @@ EOF echo "ICE_CASEDIR = ${casedir}" echo "ICE_MACHINE = ${machine}" echo "ICE_COMPILER = ${compiler}" + echo "ICE_RUNDIR = ${rundir}" echo "ICE_PES = ${task}x${thrd}" echo "ICE_GRID = ${grid} (${ICE_DECOMP_NXGLOB}x${ICE_DECOMP_NYGLOB}) blocksize=${ICE_DECOMP_BLCKX}x${ICE_DECOMP_BLCKY}x${ICE_DECOMP_MXBLCKS}" echo "ICE_DECOMP = ${ICE_DECOMP_DECOMP} ${ICE_DECOMP_DSHAPE}" @@ -809,7 +869,7 @@ setenv ICE_CASEDIR ${casedir} setenv ICE_MACHINE ${machine} setenv ICE_COMPILER ${compiler} setenv ICE_MACHCOMP ${machcomp} -setenv ICE_RUNDIR ${ICE_MACHINE_WKDIR}/${casename} +setenv ICE_RUNDIR ${rundir} setenv ICE_GRID ${grid} #setenv ICE_NXGLOB ${ICE_DECOMP_NXGLOB} # moved to namelist #setenv ICE_NYGLOB ${ICE_DECOMP_NYGLOB} # moved to namelist @@ -829,6 +889,7 @@ setenv ICE_TESTID ${testid} setenv ICE_BFBCOMP ${fbfbcomp} setenv ICE_ACCOUNT ${acct} setenv ICE_QUEUE ${queue} +setenv ICE_CODECOV ${codecovflag} EOF1 if (${sets} != "") then @@ -941,9 +1002,6 @@ EOF2 exit -1 endif -# # Initial test_output file -# echo "#---" >! test_output -# echo "PEND ${testname_noid} " >> test_output endif #------------------------------------------------------------ @@ -955,6 +1013,12 @@ EOF2 cat >> ${tsdir}/results.csh << EOF cat ${testname_base}/test_output >> results.log +EOF + + cat >> ${tsdir}/report_codecov.csh << EOF +mkdir ${testname_base}/codecov_output +cp ${rundir}/compile/*.{gcno,gcda} ${testname_base}/codecov_output/ + EOF cat >> ${tsdir}/suite.submit << EOF @@ -964,9 +1028,13 @@ echo "${testname_base}" cd ${testname_base} source ./cice.settings if (\${dobuild} == true) then - set ciceexe = "../ciceexe.\${ICE_COMPILER}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" - ./cice.build --exe \${ciceexe} - if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} + if (\${doreuse} == true) then + set ciceexe = "../ciceexe.\${ICE_COMPILER}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" + ./cice.build --exe \${ciceexe} + if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} + else + ./cice.build + endif endif if (\${dosubmit} == true) then ./cice.submit | tee -a ../suite.jobs @@ -1004,31 +1072,55 @@ EOF0 # Add code to results.csh to count the number of failures cat >> ${tsdir}/results.csh << EOF cat ./results.log -set pends = \`cat ./results.log | grep PEND | wc -l\` -set failures = \`cat ./results.log | grep FAIL | wc -l\` -set success = \`cat ./results.log | grep 'PASS\|COPY' | wc -l\` -set comments = \`cat ./results.log | grep "#" | wc -l\` -set alltotal = \`cat ./results.log | wc -l\` +set pends = \`cat ./results.log | grep PEND | wc -l\` +set misses = \`cat ./results.log | grep MISS | wc -l\` +set failures = \`cat ./results.log | grep FAIL | wc -l\` +set failbuild = \`cat ./results.log | grep FAIL | grep " build " | wc -l\` +set failrun = \`cat ./results.log | grep FAIL | grep " run " | wc -l\` +set failtest = \`cat ./results.log | grep FAIL | grep " test " | wc -l\` +set failcomp = \`cat ./results.log | grep FAIL | grep " compare " | wc -l\` +set failbfbc = \`cat ./results.log | grep FAIL | grep " bfbcomp " | wc -l\` +set failgen = \`cat ./results.log | grep FAIL | grep " generate " | wc -l\` +set success = \`cat ./results.log | grep 'PASS\|COPY' | wc -l\` +set comments = \`cat ./results.log | grep "#" | wc -l\` +set alltotal = \`cat ./results.log | wc -l\` @ total = \$alltotal - \$comments +@ chkcnt = \$pends + \$misses + \$failures + \$success echo "#------- " >> results.log echo " " >> results.log -echo "#totl = \$total" >> results.log +echo "#totl = \$total total" >> results.log +echo "#chkd = \$chkcnt checked" >> results.log echo "#pass = \$success" >> results.log -echo "#fail = \$failures" >> results.log echo "#pend = \$pends" >> results.log +echo "#miss = \$misses" >> results.log +echo "#fail = \$failures" >> results.log +echo " #failbuild = \$failbuild" >> results.log +echo " #failrun = \$failrun" >> results.log +echo " #failtest = \$failtest" >> results.log +echo " #failcomp = \$failcomp" >> results.log +echo " #failbfbc = \$failbfbc" >> results.log +echo " #failgen = \$failgen" >> results.log echo "" echo "Descriptors:" echo " PASS - successful completion" echo " COPY - previously compiled code was copied for new test" echo " MISS - comparison data is missing" -echo " PEND - run has been submitted to queue and is waiting or failed submission" -echo " FAIL - test is still executing, did not complete, or completed and failed" +echo " PEND - status is undertermined; test may still be queued, running, or timed out" +echo " FAIL - test failed" echo "" -echo "\$success of \$total tests PASSED" -echo "\$failures of \$total tests FAILED" -echo "\$pends of \$total tests PENDING" +echo "\$chkcnt measured results of \$total total results" +echo "\$success of \$chkcnt tests PASSED" +echo "\$pends of \$chkcnt tests PENDING" +echo "\$misses of \$chkcnt tests MISSING data" +echo "\$failures of \$chkcnt tests FAILED" +#echo " \$failbuild of \$failures FAILED build" +#echo " \$failrun of \$failures FAILED run" +#echo " \$failtest of \$failures FAILED test" +#echo " \$failcomp of \$failures FAILED compare" +#echo " \$failbfbc of \$failures FAILED bfbcomp" +#echo " \$failgen of \$failures FAILED generate" exit \$failures EOF @@ -1038,9 +1130,24 @@ setenv ICE_MACHINE_QSTAT ${ICE_MACHINE_QSTAT} EOF0 endif +cat >> ${tsdir}/report_codecov.csh << EOF +source ${ICE_SCRIPTS}/machines/env.${machcomp} + +if ( \${use_curl} == 1 ) then + bash -c "bash <(curl -s https://codecov.io/bash) -n '\${report_name}' -y ./codecov.yml " +else + bash -c "bash <(wget -O - https://codecov.io/bash) -n '\${report_name}' -y ./codecov.yml " +endif + +sleep 10 +rm -r -f ./*/codecov_output + +EOF + # build and submit tests cd ${tsdir} setenv SUITE_BUILD ${suitebuild} + setenv SUITE_REUSEBUILD ${suitereuse} setenv SUITE_RUN ${suiterun} setenv SUITE_SUBMIT ${suitesubmit} ./suite.submit | tee suite.log @@ -1050,6 +1157,11 @@ EOF0 ./results.csh ./report_results.csh endif + if ($codecov == 1) then + echo "Generating codecov reports" + ./poll_queue.csh + ./report_codecov.csh + endif cd ${ICE_SANDBOX} endif diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index 64137446d..40da6cb64 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -18,7 +18,7 @@ module ice_diagnostics use ice_fileunits, only: flush_fileunit use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_aero, icepack_max_iso use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags use icepack_intfc, only: icepack_query_tracer_indices @@ -79,6 +79,10 @@ module ice_diagnostics toten , & ! total ice/snow energy (J) totes ! total ice/snow energy (J) + real (kind=dbl_kind), dimension(icepack_max_iso) :: & + totison , & ! total isotope mass + totisos ! total isotope mass + real (kind=dbl_kind), dimension(icepack_max_aero) :: & totaeron , & ! total aerosol mass totaeros ! total aerosol mass @@ -89,8 +93,8 @@ module ice_diagnostics integer (kind=int_kind), parameter, public :: & check_step = 999999999, & ! begin printing at istep1=check_step iblkp = 1, & ! block number - ip = 2, & ! i index - jp = 11, & ! j index + ip = 72, & ! i index + jp = 11, & ! j index mtask = 0 ! my_task !======================================================================= @@ -113,7 +117,7 @@ subroutine runtime_diags (dt) use ice_constants, only: c1, c1000, c2, p001, p5, & field_loc_center, m2_to_km2 use ice_domain, only: distrb_info, nblocks - use ice_domain_size, only: ncat, n_aero, max_blocks, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, max_blocks, nfsd use ice_flux, only: alvdr, alidr, alvdf, alidf, evap, fsnow, frazil, & fswabs, fswthru, flw, flwout, fsens, fsurf, flat, frzmlt_init, frain, fpond, & fhocn_ai, fsalt_ai, fresh_ai, frazil_diag, & @@ -121,7 +125,7 @@ subroutine runtime_diags (dt) dsnow, congel, sst, sss, Tf, fhocn, & swvdr, swvdf, swidr, swidf, & alvdr_init, alvdf_init, alidr_init, alidf_init - use ice_flux_bgc, only: faero_atm, faero_ocn + use ice_flux_bgc, only: faero_atm, faero_ocn, fiso_atm, fiso_ocn use ice_global_reductions, only: global_sum, global_sum_prod, global_maxval use ice_grid, only: lmask_n, lmask_s, tarean, tareas use ice_state ! everything @@ -138,10 +142,11 @@ subroutine runtime_diags (dt) integer (kind=int_kind) :: & i, j, k, n, iblk, nc, & ktherm, & - nt_tsfc, nt_aero, nt_fbri, nt_apnd, nt_hpnd, nt_fsd + nt_tsfc, nt_aero, nt_fbri, nt_apnd, nt_hpnd, nt_fsd, & + nt_isosno, nt_isoice logical (kind=log_kind) :: & - tr_pond_topo, tr_brine, tr_aero, calc_Tsfc, tr_fsd + tr_pond_topo, tr_brine, tr_iso, tr_aero, calc_Tsfc, tr_fsd real (kind=dbl_kind) :: & rhow, rhos, rhoi, puny, awtvdr, awtidr, awtvdf, awtidf, & @@ -166,6 +171,13 @@ subroutine runtime_diags (dt) delein, werrn, herrn, msltn, delmsltn, serrn, & deleis, werrs, herrs, mslts, delmslts, serrs + ! isotope diagnostics + real (kind=dbl_kind), dimension(icepack_max_aero) :: & + fisoan, fisoon, isorn, & + fisoas, fisoos, isors, & + isomx1n, isomx1s, & + isototn, isotots + ! aerosol diagnostics real (kind=dbl_kind), dimension(icepack_max_aero) :: & faeran, faeron, aerrn, & @@ -188,10 +200,10 @@ 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_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) 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_fsd_out=nt_fsd,nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) 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, & @@ -683,6 +695,45 @@ subroutine runtime_diags (dt) serrn = (sfsaltn + delmsltn) / (msltn + c1) serrs = (sfsalts + delmslts) / (mslts + c1) + ! isotopes + if (tr_iso) then + do n = 1, n_iso + fisoan(n) = global_sum_prod(fiso_atm(:,:,n,:), aice_init, & + distrb_info, field_loc_center, tarean) + fisoas(n) = global_sum_prod(fiso_atm(:,:,n,:), aice_init, & + distrb_info, field_loc_center, tareas) + fisoan(n) = fisoan(n)*dt + fisoas(n) = fisoas(n)*dt + fisoon(n) = global_sum_prod(fiso_ocn(:,:,n,:), aice, & + distrb_info, field_loc_center, tarean) + fisoos(n) = global_sum_prod(fiso_ocn(:,:,n,:), aice, & + distrb_info, field_loc_center, tareas) + fisoon(n) = fisoon(n)*dt + fisoos(n) = fisoos(n)*dt + + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + work1(i,j,iblk) = c0 + do k = 1, n_iso + work1(i,j,iblk) = work1(i,j,iblk) & + + vsno(i,j,iblk)*trcr(i,j,nt_isosno+k-1,iblk) & + + vice(i,j,iblk)*trcr(i,j,nt_isoice+k-1,iblk) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + isototn(n) = global_sum(work1, distrb_info, field_loc_center, tarean) + isotots(n) = global_sum(work1, distrb_info, field_loc_center, tareas) + isomx1n(n) = global_maxval(work1, distrb_info, lmask_n) + isomx1s(n) = global_maxval(work1, distrb_info, lmask_s) + isorn(n) = (totison(n)-isototn(n)+fisoan(n)-fisoon(n))/(isototn(n)+c1) + isors(n) = (totisos(n)-isotots(n)+fisoas(n)-fisoos(n))/(isotots(n)+c1) + enddo ! n_iso + endif ! tr_iso + ! aerosols if (tr_aero) then do n = 1, n_aero @@ -917,6 +968,17 @@ subroutine runtime_diags (dt) write(nu_diag,901) 'arwt salt flx error = ',serrn,serrs write(nu_diag,*) '----------------------------' + if (tr_iso) then + do n = 1, n_iso + write(nu_diag,*) ' isotope ',n + write(nu_diag,901) 'fiso_atm (kg/m2) = ', fisoan(n), fisoas(n) + write(nu_diag,901) 'fiso_ocn (kg/m2) = ', fisoon(n), fisoos(n) + write(nu_diag,901) 'total iso (kg/m2) = ', isototn(n), isotots(n) + write(nu_diag,901) 'iso error = ', isorn(n), isors(n) + write(nu_diag,901) 'maximum iso (kg/m2) = ', isomx1n(n),isomx1s(n) + enddo + write(nu_diag,*) '----------------------------' + endif ! tr_iso if (tr_aero) then do n = 1, n_aero write(nu_diag,*) ' aerosol ',n @@ -1030,16 +1092,16 @@ subroutine init_mass_diags use ice_blocks, only: nx_block, ny_block use ice_constants, only: field_loc_center use ice_domain, only: distrb_info, nblocks - use ice_domain_size, only: n_aero, ncat, max_blocks + use ice_domain_size, only: n_iso, n_aero, ncat, max_blocks use ice_global_reductions, only: global_sum use ice_grid, only: tareas, tarean use ice_state, only: aicen, vice, vsno, trcrn, trcr - integer (kind=int_kind) :: n, i, j, iblk, & - nt_hpnd, nt_apnd, nt_aero + integer (kind=int_kind) :: n, i, j, k, iblk, & + nt_hpnd, nt_apnd, nt_aero, nt_isosno, nt_isoice logical (kind=log_kind) :: & - tr_aero, tr_pond_topo + tr_iso, tr_aero, tr_pond_topo real (kind=dbl_kind) :: & shmaxn, snwmxn, shmaxs, snwmxs, totpn, totps, & @@ -1051,7 +1113,8 @@ subroutine init_mass_diags character(len=*), parameter :: subname = '(init_mass_diags)' call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_pond_topo_out=tr_pond_topo) - call icepack_query_tracer_indices( & + call icepack_query_tracer_flags(tr_iso_out=tr_iso) + call icepack_query_tracer_indices(nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & nt_hpnd_out=nt_hpnd, nt_apnd_out=nt_apnd, nt_aero_out=nt_aero) call icepack_query_parameters( & rhoi_out=rhoi, rhos_out=rhos, rhofresh_out=rhofresh) @@ -1094,6 +1157,27 @@ subroutine init_mass_diags enddo ! npnt endif ! print_points + if (tr_iso) then + do n=1,n_iso + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1, ny_block + do i = 1, nx_block + work1(i,j,iblk) = c0 + do k = 1, n_iso + work1(i,j,iblk) = work1(i,j,iblk) & + + vsno(i,j,iblk)*trcr(i,j,nt_isosno+k-1,iblk) & + + vice(i,j,iblk)*trcr(i,j,nt_isoice+k-1,iblk) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + totison(n)= global_sum(work1, distrb_info, field_loc_center, tarean) + totisos(n)= global_sum(work1, distrb_info, field_loc_center, tareas) + enddo + endif + if (tr_aero) then do n=1,n_aero !$OMP PARALLEL DO PRIVATE(iblk,i,j) @@ -1480,18 +1564,20 @@ subroutine print_state(plabel,i,j,iblk) qi, qs, Tsnow, & rad_to_deg, puny, rhoi, lfresh, rhos, cp_ice - integer (kind=int_kind) :: n, k, nt_Tsfc, nt_qice, nt_qsno, nt_fsd + integer (kind=int_kind) :: n, k, nt_Tsfc, nt_qice, nt_qsno, nt_fsd, & + nt_isosno, nt_isoice - logical (kind=log_kind) :: tr_fsd + logical (kind=log_kind) :: tr_fsd, tr_iso 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) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_iso_out=tr_iso) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno, nt_fsd_out=nt_fsd) + nt_qsno_out=nt_qsno, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) 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) @@ -1521,6 +1607,8 @@ 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 write(nu_diag,*) ' ' ! dynamics (transport and/or ridging) causes the floe size distribution to become non-normal diff --git a/cicecore/cicedynB/analysis/ice_history_bgc.F90 b/cicecore/cicedynB/analysis/ice_history_bgc.F90 index c27683423..1ae572b30 100644 --- a/cicecore/cicedynB/analysis/ice_history_bgc.F90 +++ b/cicecore/cicedynB/analysis/ice_history_bgc.F90 @@ -14,13 +14,13 @@ module ice_history_bgc 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_max_aero, icepack_max_dic, & - icepack_max_doc, icepack_max_don, & + use icepack_intfc, only: icepack_max_iso, icepack_max_aero, & + icepack_max_dic, icepack_max_doc, icepack_max_don, & icepack_max_algae, icepack_max_fe use icepack_intfc, only: icepack_query_tracer_flags, & icepack_query_tracer_indices, icepack_query_parameters, & icepack_query_parameters - use ice_domain_size, only: max_nstrm, n_aero, & + use ice_domain_size, only: max_nstrm, n_iso, n_aero, & n_algae, n_dic, n_doc, n_don, n_zaero, n_fed, n_fep implicit none @@ -35,6 +35,8 @@ module ice_history_bgc ! specified in input_templates !-------------------------------------------------------------- character (len=max_nstrm), public :: & + f_fiso_atm = 'x', f_fiso_ocn = 'x', & + f_iso = 'x', & f_faero_atm = 'x', f_faero_ocn = 'x', & f_aero = 'x', & f_fzsal = 'm', f_fzsal_ai = 'm', & @@ -124,6 +126,8 @@ module ice_history_bgc !--------------------------------------------------------------- namelist / icefields_bgc_nml / & + f_fiso_atm , f_fiso_ocn , & + f_iso , & f_faero_atm , f_faero_ocn , & f_aero , & f_fbio , f_fbio_ai , & @@ -154,6 +158,12 @@ module ice_history_bgc n_fzsal_g , n_fzsal_g_ai , & n_zsal + integer(kind=int_kind), dimension(icepack_max_iso,max_nstrm) :: & + n_fiso_atm , & + n_fiso_ocn , & + n_isosno , & + n_isoice + integer(kind=int_kind), dimension(icepack_max_aero,max_nstrm) :: & n_faero_atm , & n_faero_ocn , & @@ -266,7 +276,7 @@ subroutine init_hist_bgc_2D integer (kind=int_kind) :: nml_error ! namelist i/o error flag character (len=3) :: nchar character (len=16) :: vname_in ! variable name - logical (kind=log_kind) :: tr_zaero, tr_aero, tr_brine, & + logical (kind=log_kind) :: tr_zaero, tr_aero, tr_brine, tr_iso, & tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil, & tr_bgc_DMS, tr_bgc_PON, & tr_bgc_N, tr_bgc_C, tr_bgc_chl, & @@ -276,7 +286,8 @@ subroutine init_hist_bgc_2D call icepack_query_parameters(skl_bgc_out=skl_bgc, & solve_zsal_out=solve_zsal, z_tracers_out=z_tracers) - call icepack_query_tracer_flags(tr_zaero_out =tr_zaero, & + call icepack_query_tracer_flags( & + tr_iso_out =tr_iso, tr_zaero_out =tr_zaero, & tr_aero_out =tr_aero, tr_brine_out =tr_brine, & tr_bgc_Nit_out=tr_bgc_Nit, tr_bgc_Am_out =tr_bgc_Am, & tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_DMS_out=tr_bgc_DMS, & @@ -313,6 +324,12 @@ subroutine init_hist_bgc_2D call abort_ice(subname//'ERROR: reading icefields_bgc_nml') endif + if (.not. tr_iso) then + f_fiso_atm = 'x' + f_fiso_ocn = 'x' + f_iso = 'x' + endif + if (.not. tr_aero) then f_faero_atm = 'x' f_faero_ocn = 'x' @@ -609,6 +626,9 @@ subroutine init_hist_bgc_2D f_iki = 'x' endif + call broadcast_scalar (f_fiso_atm, master_task) + call broadcast_scalar (f_fiso_ocn, master_task) + call broadcast_scalar (f_iso, master_task) call broadcast_scalar (f_faero_atm, master_task) call broadcast_scalar (f_faero_ocn, master_task) call broadcast_scalar (f_aero, master_task) @@ -758,10 +778,44 @@ subroutine init_hist_bgc_2D ! 2D variables - if (tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then + if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then do ns = 1, nstreams + if (f_iso(1:1) /= 'x') then + do n=1,n_iso + write(nchar,'(i3.3)') n + write(vname_in,'(a,a)') 'isosno', trim(nchar) + call define_hist_field(n_isosno(n,:),vname_in,"kg/kg", & + tstr2D, tcstr,"snow isotope mass concentration","none", c1, c0, & + ns, f_iso) + write(vname_in,'(a,a)') 'isoice', trim(nchar) + call define_hist_field(n_isoice(n,:),vname_in,"kg/kg", & + tstr2D, tcstr,"ice isotope mass concentration","none", c1, c0, & + ns, f_iso) + enddo + endif + + if (f_fiso_atm(1:1) /= 'x') then + do n=1,n_iso + write(nchar,'(i3.3)') n + write(vname_in,'(a,a)') 'fiso_atm', trim(nchar) + call define_hist_field(n_fiso_atm(n,:),vname_in,"kg/m^2 s", & + tstr2D, tcstr,"isotope deposition rate","none", c1, c0, & + ns, f_fiso_atm) + enddo + endif + + if (f_fiso_ocn(1:1) /= 'x') then + do n=1,n_iso + write(nchar,'(i3.3)') n + write(vname_in,'(a,a)') 'fiso_ocn', trim(nchar) + call define_hist_field(n_fiso_ocn(n,:),vname_in,"kg/m^2 s", & + tstr2D, tcstr,"isotope flux to ocean","none", c1, c0, & + ns, f_fiso_ocn) + enddo + endif + ! zsalinity call define_hist_field(n_fzsal,"fzsal","kg/m^2/s",tstr2D, tcstr, & @@ -1839,8 +1893,8 @@ subroutine accum_hist_bgc (iblk) use ice_domain, only: blocks_ice use ice_domain_size, only: nblyr use ice_flux, only: sss - use ice_flux_bgc, only: faero_atm, faero_ocn, flux_bio, flux_bio_ai, & - fzsal_ai, fzsal_g_ai + use ice_flux_bgc, only: fiso_atm, fiso_ocn, faero_atm, faero_ocn, & + flux_bio, flux_bio_ai, fzsal_ai, fzsal_g_ai use ice_history_shared, only: n2D, a2D, a3Dc, & n3Dzcum, n3Dbcum, a3Db, a3Da, & ncat_hist, accum_hist_field, nzblyr, nzalyr @@ -1873,15 +1927,16 @@ subroutine accum_hist_bgc (iblk) workii logical (kind=log_kind) :: & - skl_bgc, z_tracers, tr_aero, tr_brine, solve_zsal - - integer(kind=int_kind) :: nt_aero, nt_fbri, & - nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, nt_bgc_DMSPp, & - nt_bgc_DMSPd, nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & - nt_zbgc_frac, nlt_chl_sw, & - nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & - nlt_bgc_DMS, nlt_bgc_PON, & - nlt_bgc_DMSPp, nlt_bgc_DMSPd, & + skl_bgc, z_tracers, tr_iso, tr_aero, tr_brine, solve_zsal + + integer(kind=int_kind) :: & + nt_isosno, nt_isoice, nt_aero, nt_fbri, & + nt_bgc_Nit, nt_bgc_Am, nt_bgc_Sil, nt_bgc_DMSPp, & + nt_bgc_DMSPd, nt_bgc_DMS, nt_bgc_PON, nt_bgc_S, & + nt_zbgc_frac, nlt_chl_sw, & + nlt_bgc_Nit, nlt_bgc_Am, nlt_bgc_Sil, & + nlt_bgc_DMS, nlt_bgc_PON, & + nlt_bgc_DMSPp, nlt_bgc_DMSPd, & nt_bgc_hum, nlt_bgc_hum integer (kind=int_kind), dimension(icepack_max_aero) :: & @@ -1915,11 +1970,13 @@ subroutine accum_hist_bgc (iblk) call icepack_query_parameters(rhos_out=rhos, rhoi_out=rhoi, & rhow_out=rhow, puny_out=puny, sk_l_out=sk_l) - call icepack_query_tracer_flags( & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & tr_aero_out=tr_aero, tr_brine_out=tr_brine) call icepack_query_parameters(skl_bgc_out=skl_bgc, & solve_zsal_out=solve_zsal, z_tracers_out=z_tracers) - call icepack_query_tracer_indices( nt_aero_out=nt_aero, & + call icepack_query_tracer_indices( & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_aero_out=nt_aero, & nt_fbri_out=nt_fbri, nt_bgc_DOC_out=nt_bgc_DOC, & nt_zaero_out=nt_zaero, nt_bgc_DIC_out=nt_bgc_DIC, & nt_bgc_DON_out=nt_bgc_DON, nt_bgc_N_out=nt_bgc_N, & @@ -1955,7 +2012,7 @@ subroutine accum_hist_bgc (iblk) ! increment field !--------------------------------------------------------------- - if (tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then + if (tr_iso .or. tr_aero .or. tr_brine .or. solve_zsal .or. skl_bgc) then ! 2d bgc fields @@ -1971,6 +2028,28 @@ subroutine accum_hist_bgc (iblk) if (f_zsal (1:1) /= 'x') & call accum_hist_field(n_zsal, iblk, zsal_tot(:,:,iblk), a2D) + ! isotopes + if (f_fiso_atm(1:1) /= 'x') then + do n=1,n_iso + call accum_hist_field(n_fiso_atm(n,:),iblk, & + fiso_atm(:,:,n,iblk), a2D) + enddo + endif + if (f_fiso_ocn(1:1) /= 'x') then + do n=1,n_iso + call accum_hist_field(n_fiso_ocn(n,:),iblk, & + fiso_ocn(:,:,n,iblk), a2D) + enddo + endif + if (f_iso(1:1) /= 'x') then + do n=1,n_iso + call accum_hist_field(n_isosno(n,:), iblk, & + trcr(:,:,nt_isosno+n-1,iblk)/rhos, a2D) + call accum_hist_field(n_isoice(n,:), iblk, & + trcr(:,:,nt_isoice+n-1,iblk)/rhos, a2D) + enddo + endif + ! Aerosols if (f_faero_atm(1:1) /= 'x') then do n=1,n_aero diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index 86c5a67c4..7eaba64cf 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -44,11 +44,11 @@ module ice_transport_driver integer (kind=int_kind) :: & ntrace ! number of tracers in use - integer (kind=int_kind), dimension(:), allocatable :: & + integer (kind=int_kind), dimension(:), allocatable, public :: & tracer_type ,&! = 1, 2, or 3 (depends on 0, 1 or 2 other tracers) depend ! tracer dependencies (see below) - logical (kind=log_kind), dimension (:), allocatable :: & + logical (kind=log_kind), dimension (:), allocatable, public :: & has_dependents ! true if a tracer has dependent tracers integer (kind=int_kind), parameter :: & @@ -82,7 +82,7 @@ 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_bgc_Nit, nt_bgc_S + nt_apnd, nt_hpnd, nt_ipnd, nt_fsd, nt_isosno, nt_isoice, nt_bgc_Nit, nt_bgc_S character(len=*), parameter :: subname = '(init_transport)' @@ -93,7 +93,8 @@ subroutine init_transport 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_ipnd_out=nt_ipnd, 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, & file=__FILE__, line=__LINE__) @@ -194,6 +195,12 @@ subroutine init_transport if (nt-k==nt_fsd) & write(nu_diag,*) 'nt_fsd ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) + if (nt-k==nt_isosno) & + write(nu_diag,*) 'nt_isosno',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) + if (nt-k==nt_isoice) & + write(nu_diag,*) 'nt_isoice',nt,depend(nt),tracer_type(nt),& + has_dependents(nt) if (nt-k==nt_bgc_Nit) & write(nu_diag,*) 'nt_bgc_Nit',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 afefef9d3..607b763eb 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -527,7 +527,7 @@ end subroutine alloc_flux subroutine init_coupler_flux use ice_arrays_column, only: Cdn_atm - use ice_flux_bgc, only: flux_bio_atm, flux_bio, faero_atm, & + use ice_flux_bgc, only: flux_bio_atm, flux_bio, faero_atm, fiso_atm, & fnit, famm, fsil, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdon, fdic, ffed, ffep use ice_grid, only: bathymetry @@ -617,6 +617,7 @@ subroutine init_coupler_flux fsensn_f (:,:,:,:) = c0 ! sensible heat flux (W/m^2) endif ! + fiso_atm (:,:,:,:) = c0 ! isotope deposition rate (kg/m2/s) faero_atm (:,:,:,:) = c0 ! aerosol deposition rate (kg/m2/s) flux_bio_atm (:,:,:,:) = c0 ! zaero and bio deposition rate (kg/m2/s) @@ -727,6 +728,8 @@ end subroutine init_coupler_flux subroutine init_flux_atm + use ice_flux_bgc, only: fiso_evap, Qref_iso, Qa_iso + character(len=*), parameter :: subname = '(init_flux_atm)' !----------------------------------------------------------------- @@ -748,6 +751,10 @@ subroutine init_flux_atm Qref (:,:,:) = c0 Uref (:,:,:) = c0 + fiso_evap(:,:,:,:) = c0 + Qref_iso (:,:,:,:) = c0 + Qa_iso (:,:,:,:) = c0 + end subroutine init_flux_atm !======================================================================= @@ -763,7 +770,7 @@ end subroutine init_flux_atm subroutine init_flux_ocn - use ice_flux_bgc, only: faero_ocn + use ice_flux_bgc, only: faero_ocn, fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn character(len=*), parameter :: subname = '(init_flux_ocn)' @@ -776,7 +783,12 @@ subroutine init_flux_ocn fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 - faero_ocn(:,:,:,:) = c0 + + faero_ocn (:,:,:,:) = c0 + fiso_ocn (:,:,:,:) = c0 + HDO_ocn (:,:,:) = c0 + H2_16O_ocn (:,:,:) = c0 + H2_18O_ocn (:,:,:) = c0 end subroutine init_flux_ocn @@ -972,7 +984,11 @@ subroutine scale_fluxes (nx_block, ny_block, & fzsal, fzsal_g, & flux_bio, & fsurf, fcondtop, & - Uref, wind ) + Uref, wind, & + Qref_iso, & + fiso_evap,fiso_ocn) + + use icepack_intfc, only: icepack_max_iso integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions @@ -1030,6 +1046,13 @@ subroutine scale_fluxes (nx_block, ny_block, & fzsal , & ! salt flux to ocean with prognositic salinity (kg/m2/s) fzsal_g ! Gravity drainage salt flux to ocean (kg/m2/s) + ! isotopes + real (kind=dbl_kind), dimension(nx_block,ny_block,icepack_max_iso), & + optional, intent(inout) :: & + Qref_iso , & ! isotope air sp hum reference level (kg/kg) + fiso_evap, & ! isotope evaporation (kg/m2/s) + fiso_ocn ! isotope flux to ocean (kg/m2/s) + ! local variables real (kind=dbl_kind) :: & @@ -1078,6 +1101,9 @@ subroutine scale_fluxes (nx_block, ny_block, & fzsal_g (i,j) = fzsal_g (i,j) * ar flux_bio (i,j,:) = flux_bio (i,j,:) * ar faero_ocn(i,j,:) = faero_ocn(i,j,:) * ar + if (present(Qref_iso )) Qref_iso (i,j,:) = Qref_iso (i,j,:) * ar + if (present(fiso_evap)) fiso_evap(i,j,:) = fiso_evap(i,j,:) * ar + if (present(fiso_ocn )) fiso_ocn (i,j,:) = fiso_ocn (i,j,:) * ar else ! zero out fluxes strairxT(i,j) = c0 strairyT(i,j) = c0 @@ -1103,6 +1129,9 @@ subroutine scale_fluxes (nx_block, ny_block, & fzsal_g (i,j) = c0 flux_bio (i,j,:) = c0 faero_ocn(i,j,:) = c0 + if (present(Qref_iso )) Qref_iso (i,j,:) = c0 + if (present(fiso_evap)) fiso_evap(i,j,:) = c0 + if (present(fiso_ocn )) fiso_ocn (i,j,:) = c0 endif ! tmask and aice > 0 enddo ! i enddo ! j diff --git a/cicecore/cicedynB/general/ice_flux_bgc.F90 b/cicecore/cicedynB/general/ice_flux_bgc.F90 index 2ff193b2f..56e644431 100644 --- a/cicecore/cicedynB/general/ice_flux_bgc.F90 +++ b/cicecore/cicedynB/general/ice_flux_bgc.F90 @@ -12,7 +12,7 @@ module ice_flux_bgc 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_max_aero, icepack_max_nbtrcr, & + use icepack_intfc, only: icepack_max_iso, icepack_max_aero, icepack_max_nbtrcr, & icepack_max_algae, icepack_max_doc, icepack_max_don, icepack_max_dic, icepack_max_fe, & icepack_query_tracer_indices, icepack_query_tracer_flags, icepack_query_parameters @@ -23,22 +23,22 @@ module ice_flux_bgc ! in from atmosphere - real (kind=dbl_kind), & !coupling variable for both tr_aero and tr_zaero + real (kind=dbl_kind), & ! coupling variable for both tr_aero and tr_zaero dimension (:,:,:,:), allocatable, public :: & + fiso_atm, & ! isotope deposition rate (kg/m^2 s) faero_atm ! aerosol deposition rate (kg/m^2 s) real (kind=dbl_kind), & dimension (:,:,:,:), allocatable, public :: & flux_bio_atm ! all bio fluxes to ice from atmosphere - ! in from ocean + ! out to ocean real (kind=dbl_kind), & dimension (:,:,:,:), allocatable, public :: & + fiso_ocn, & ! isotope flux to ocean (kg/m^2/s) faero_ocn ! aerosol flux to ocean (kg/m^2/s) - ! out to ocean - real (kind=dbl_kind), & dimension (:,:,:,:), allocatable, public :: & flux_bio , & ! all bio fluxes to ocean @@ -95,6 +95,19 @@ module ice_flux_bgc real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & zaeros ! ocean aerosols (mmol/m^3) + ! isotopes + real (kind=dbl_kind), & ! coupling variable for tr_iso + dimension (:,:,:,:), allocatable, public :: & + fiso_evap , & ! isotope evaporation rate (kg/m^2 s) + Qa_iso , & ! isotope specific humidity (kg/kg) + Qref_iso ! 2m atm reference isotope spec humidity (kg/kg) + + real (kind=dbl_kind), & ! coupling variable for tr_iso + dimension (:,:,:), allocatable, public :: & + HDO_ocn , & ! seawater concentration of HDO (kg/kg) + H2_16O_ocn, & ! seawater concentration of H2_16O (kg/kg) + H2_18O_ocn ! seawater concentration of H2_18O (kg/kg) + !======================================================================= contains @@ -125,6 +138,14 @@ subroutine alloc_flux_bgc fdust (nx_block,ny_block,max_blocks), & ! ice-ocean dust flux (kg/m^2/s), positive to ocean hin_old (nx_block,ny_block,ncat,max_blocks), & ! old ice thickness dsnown (nx_block,ny_block,ncat,max_blocks), & ! change in snow thickness in category n (m) + HDO_ocn (nx_block,ny_block,max_blocks), & ! seawater concentration of HDO (kg/kg) + H2_16O_ocn (nx_block,ny_block,max_blocks), & ! seawater concentration of H2_16O (kg/kg) + H2_18O_ocn (nx_block,ny_block,max_blocks), & ! seawater concentration of H2_18O (kg/kg) + Qa_iso (nx_block,ny_block,icepack_max_iso,max_blocks), & ! isotope specific humidity (kg/kg) + Qref_iso (nx_block,ny_block,icepack_max_iso,max_blocks), & ! 2m atm reference isotope spec humidity (kg/kg) + fiso_atm (nx_block,ny_block,icepack_max_iso,max_blocks), & ! isotope deposition rate (kg/m^2 s) + fiso_evap (nx_block,ny_block,icepack_max_iso,max_blocks), & ! isotope evaporation rate (kg/m^2 s) + fiso_ocn (nx_block,ny_block,icepack_max_iso,max_blocks), & ! isotope flux to ocean (kg/m^2/s) faero_atm (nx_block,ny_block,icepack_max_aero,max_blocks), & ! aerosol deposition rate (kg/m^2 s) faero_ocn (nx_block,ny_block,icepack_max_aero,max_blocks), & ! aerosol flux to ocean (kg/m^2/s) zaeros (nx_block,ny_block,icepack_max_aero,max_blocks), & ! ocean aerosols (mmol/m^3) diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 0632408bf..64f4b4834 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -72,7 +72,7 @@ module ice_forcing sublim_file, & snow_file - character (char_len_long), dimension(:), allocatable :: & ! input data file names + character (char_len_long), dimension(:), allocatable, public :: & ! input data file names topmelt_file, & botmelt_file @@ -84,10 +84,10 @@ module ice_forcing oldrecnum = 0 , & ! old record number (save between steps) oldrecnum4X = 0 ! - real (kind=dbl_kind), dimension(:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & cldf ! cloud fraction - real (kind=dbl_kind), dimension(:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & fsw_data, & ! field values at 2 temporal data points cldf_data, & fsnow_data, & @@ -107,8 +107,7 @@ module ice_forcing sublim_data, & frain_data - real (kind=dbl_kind), & - dimension(:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension(:,:,:,:,:), allocatable, public :: & topmelt_data, & botmelt_data @@ -141,8 +140,7 @@ module ice_forcing frcidr = 0.31_dbl_kind, & ! frac of incoming sw in near IR direct band frcidf = 0.17_dbl_kind ! frac of incoming sw in near IR diffuse band - real (kind=dbl_kind), & - dimension (:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & ocn_frc_m ! ocn data for 12 months logical (kind=log_kind), public :: & @@ -4362,8 +4360,8 @@ subroutine hycom_atm_files fsw_file = trim(atm_data_dir)//'/forcing.shwflx.nc' flw_file = trim(atm_data_dir)//'/forcing.radflx.nc' rain_file = trim(atm_data_dir)//'/forcing.precip.nc' - uwind_file = trim(atm_data_dir)//'/forcing.ewndsp.nc' !actually Xward, not Eward - vwind_file = trim(atm_data_dir)//'/forcing.nwndsp.nc' !actually Yward, not Nward + uwind_file = trim(atm_data_dir)//'/forcing.wndewd.nc' + vwind_file = trim(atm_data_dir)//'/forcing.wndnwd.nc' tair_file = trim(atm_data_dir)//'/forcing.airtmp.nc' humid_file = trim(atm_data_dir)//'/forcing.vapmix.nc' @@ -4469,11 +4467,11 @@ subroutine hycom_atm_data call read_data_nc_hycom (read6, recnum, & tair_file, fieldname, Tair_data, & field_loc_center, field_type_scalar) - fieldname = 'ewndsp' + fieldname = 'wndewd' call read_data_nc_hycom (read6, recnum, & uwind_file, fieldname, uatm_data, & field_loc_center, field_type_vector) - fieldname = 'nwndsp' + fieldname = 'wndnwd' call read_data_nc_hycom (read6, recnum, & vwind_file, fieldname, vatm_data, & field_loc_center, field_type_vector) diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index 6e543a056..4eedcfb80 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -29,16 +29,17 @@ module ice_forcing_bgc implicit none private public :: get_forcing_bgc, get_atm_bgc, fzaero_data, alloc_forcing_bgc, & - init_bgc_data, faero_data, faero_default, faero_optics + init_bgc_data, faero_data, faero_default, faero_optics, & + fiso_default integer (kind=int_kind) :: & bgcrecnum = 0 ! old record number (save between steps) - real (kind=dbl_kind), dimension(:,:,:), allocatable :: & - nitdat , & ! data value toward which nitrate is restored - sildat ! data value toward which silicate is restored + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & + nitdat , & ! data value toward which nitrate is restored + sildat ! data value toward which silicate is restored - real (kind=dbl_kind), dimension(:,:,:,:), allocatable, save :: & + real (kind=dbl_kind), dimension(:,:,:,:), allocatable, public :: & nit_data, & ! field values at 2 temporal data points sil_data @@ -538,6 +539,21 @@ end subroutine get_atm_bgc !======================================================================= +! constant values for atmospheric water isotopes +! +! authors: David Bailey, NCAR + + subroutine fiso_default + + use ice_flux_bgc, only: fiso_atm + character(len=*), parameter :: subname='(fiso_default)' + + fiso_atm(:,:,:,:) = 1.e-14_dbl_kind ! kg/m^2 s + + end subroutine fiso_default + +!======================================================================= + ! constant values for atmospheric aerosols ! ! authors: Elizabeth Hunke, LANL diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 41ff70aec..ffb070644 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -61,7 +61,7 @@ subroutine input_data use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt use ice_domain, only: close_boundaries use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & - n_aero, n_zaero, n_algae, & + n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & max_nstrm use ice_calendar, only: year_init, istep0, histfreq, histfreq_n, & @@ -71,7 +71,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_fsd, restart_iso use ice_restart_shared, only: & restart, restart_ext, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 @@ -126,12 +126,13 @@ subroutine input_data logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec - logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_aero, tr_fsd + 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_pond_cesm, tr_pond_lvl, tr_pond_topo integer (kind=int_kind) :: numin, numax ! unit number limits integer (kind=int_kind) :: rpcesm, rplvl, rptopo - real (kind=dbl_kind) :: Cf, puny + real (kind=dbl_kind) :: Cf, ksno, puny integer :: abort_flag character (len=64) :: tmpstr @@ -168,13 +169,14 @@ subroutine input_data tr_pond_cesm, restart_pond_cesm, & tr_pond_lvl, restart_pond_lvl, & tr_pond_topo, restart_pond_topo, & + tr_iso, restart_iso, & tr_aero, restart_aero, & tr_fsd, restart_fsd, & - n_aero, n_zaero, n_algae, & + n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep namelist /thermo_nml/ & - kitd, ktherm, conduct, & + kitd, ktherm, conduct, ksno, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy @@ -294,6 +296,7 @@ subroutine input_data krdg_redist = 1 ! 1 = new redistribution, 0 = Hibler 80 mu_rdg = 3 ! e-folding scale of ridged ice, krdg_partic=1 (m^0.5) Cf = 17.0_dbl_kind ! ratio of ridging work to PE change in ridging + ksno = 0.3_dbl_kind ! snow thermal conductivity close_boundaries = .false. ! true = set land on edges of grid basalstress= .false. ! if true, basal stress for landfast is on k1 = 8.0_dbl_kind ! 1st free parameter for landfast parameterization @@ -392,11 +395,14 @@ 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_iso = .false. ! isotopes + restart_iso = .false. ! isotopes restart tr_aero = .false. ! aerosols restart_aero = .false. ! aerosols restart tr_fsd = .false. ! floe size distribution restart_fsd = .false. ! floe size distribution restart + n_iso = 0 n_aero = 0 n_zaero = 0 n_algae = 0 @@ -571,6 +577,7 @@ subroutine input_data call broadcast_scalar(krdg_redist, master_task) call broadcast_scalar(mu_rdg, master_task) call broadcast_scalar(Cf, master_task) + call broadcast_scalar(ksno, master_task) call broadcast_scalar(basalstress, master_task) call broadcast_scalar(k1, master_task) call broadcast_scalar(k2, master_task) @@ -660,6 +667,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_iso, master_task) + call broadcast_scalar(restart_iso, master_task) call broadcast_scalar(tr_aero, master_task) call broadcast_scalar(restart_aero, master_task) call broadcast_scalar(tr_fsd, master_task) @@ -669,6 +678,7 @@ subroutine input_data call broadcast_scalar(nilyr, master_task) call broadcast_scalar(nslyr, master_task) call broadcast_scalar(nblyr, master_task) + call broadcast_scalar(n_iso, master_task) call broadcast_scalar(n_aero, master_task) call broadcast_scalar(n_zaero, master_task) call broadcast_scalar(n_algae, master_task) @@ -721,6 +731,7 @@ subroutine input_data if (my_task == master_task) & write(nu_diag,*) subname//' WARNING: ice_ic = none or default, setting restart flags to .false.' restart = .false. + restart_iso = .false. restart_aero = .false. restart_fsd = .false. restart_age = .false. @@ -828,6 +839,15 @@ subroutine input_data abort_flag = 8 endif + if (tr_iso .and. n_iso==0) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: isotopes activated but' + write(nu_diag,*) subname//' ERROR: not allocated in tracer array.' + write(nu_diag,*) subname//' ERROR: Activate in compilation script.' + endif + abort_flag = 31 + endif + if (tr_aero .and. n_aero==0) then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: aerosols activated but' @@ -931,6 +951,7 @@ subroutine input_data ice_IOUnitsMaxUnit = numax call icepack_init_parameters(Cf_in=Cf) + call icepack_init_parameters(ksno_in=ksno) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname//'Icepack Abort1', & file=__FILE__, line=__LINE__) @@ -1055,6 +1076,7 @@ subroutine input_data trim(advection) write(nu_diag,1030) ' shortwave = ', & trim(shortwave) + write(nu_diag,1000) ' ksno = ', ksno if (cpl_bgc) then write(nu_diag,1000) ' BGC coupling is switched ON' else @@ -1197,6 +1219,8 @@ subroutine input_data write(nu_diag,1010) ' restart_pond_lvl = ', restart_pond_lvl write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo write(nu_diag,1010) ' restart_pond_topo = ', restart_pond_topo + write(nu_diag,1010) ' tr_iso = ', tr_iso + write(nu_diag,1010) ' restart_iso = ', restart_iso write(nu_diag,1010) ' tr_aero = ', tr_aero write(nu_diag,1010) ' restart_aero = ', restart_aero write(nu_diag,1010) ' tr_fsd = ', tr_fsd @@ -1207,6 +1231,7 @@ subroutine input_data write(nu_diag,1020) ' nilyr = ', nilyr write(nu_diag,1020) ' nslyr = ', nslyr write(nu_diag,1020) ' nblyr = ', nblyr + write(nu_diag,1020) ' n_iso = ', n_iso write(nu_diag,1020) ' n_aero = ', n_aero write(nu_diag,1020) ' n_zaero = ', n_zaero write(nu_diag,1020) ' n_algae = ', n_algae @@ -1270,10 +1295,12 @@ 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) call icepack_init_tracer_flags(tr_iage_in=tr_iage, tr_FY_in=tr_FY, & - tr_lvl_in=tr_lvl, tr_aero_in=tr_aero, tr_fsd_in=tr_fsd, tr_pond_in=tr_pond, & + 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_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_aero_in=n_aero, n_DOC_in=n_DOC, n_DON_in=n_DON, & + nfsd_in=nfsd, n_algae_in=n_algae, n_iso_in=n_iso, n_aero_in=n_aero, & + n_DOC_in=n_DOC, n_DON_in=n_DON, & n_DIC_in=n_DIC, n_fed_in=n_fed, n_fep_in=n_fep, n_zaero_in=n_zaero) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1301,7 +1328,7 @@ subroutine init_state use ice_blocks, only: block, get_block, nx_block, ny_block use ice_domain, only: nblocks, blocks_ice - use ice_domain_size, only: ncat, nilyr, nslyr, n_aero, nfsd + use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero, nfsd use ice_flux, only: sst, Tf, Tair, salinz, Tmltz use ice_grid, only: tmask, ULON, TLAT use ice_state, only: trcr_depend, aicen, trcrn, vicen, vsnon, & @@ -1322,11 +1349,11 @@ subroutine init_state heat_capacity ! from icepack integer (kind=int_kind) :: ntrcr - logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_aero, tr_fsd + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_fsd logical (kind=log_kind) :: 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 + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd + integer (kind=int_kind) :: nt_isosno, nt_isoice, nt_aero, nt_fsd type (block) :: & this_block ! block information for current block @@ -1338,12 +1365,14 @@ 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_aero_out=tr_aero, tr_fsd_out=tr_fsd, & + 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) 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_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -1423,6 +1452,12 @@ subroutine init_state trcr_depend(nt_fsd + it - 1) = 0 ! area-weighted floe size distribution enddo endif + if (tr_iso) then ! isotopes + do it = 1, n_iso + trcr_depend(nt_isosno+it-1) = 2 ! snow + trcr_depend(nt_isoice+it-1) = 1 ! ice + enddo + endif if (tr_aero) then ! volume-weighted aerosols do it = 1, n_aero trcr_depend(nt_aero+(it-1)*4 ) = 2 ! snow diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index b8d796710..e389adc87 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -27,7 +27,7 @@ module ice_step_mod use icepack_intfc, only: icepack_biogeochemistry, icepack_load_ocean_bio_array use icepack_intfc, only: icepack_max_algae, icepack_max_nbtrcr, icepack_max_don use icepack_intfc, only: icepack_max_doc, icepack_max_dic, icepack_max_aero - use icepack_intfc, only: icepack_max_fe + use icepack_intfc, only: icepack_max_fe, icepack_max_iso use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes use icepack_intfc, only: icepack_query_tracer_indices @@ -161,7 +161,7 @@ subroutine step_therm1 (dt, iblk) use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: yday use ice_domain, only: blocks_ice - use ice_domain_size, only: ncat, nilyr, nslyr, n_aero + use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero 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, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & @@ -170,7 +170,8 @@ subroutine step_therm1 (dt, iblk) flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & fswthru, meltt, melts, meltb, congel, snoice, & flatn_f, fsensn_f, fsurfn_f, fcondtopn_f - use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn + use ice_flux_bgc, only: dsnown, faero_atm, faero_ocn, fiso_atm, fiso_ocn, & + Qa_iso, Qref_iso, fiso_evap, HDO_ocn, H2_16O_ocn, H2_18O_ocn use ice_grid, only: lmask_n, lmask_s, tmask use ice_state, only: aice, aicen, aice_init, aicen_init, vicen_init, & vice, vicen, vsno, vsnon, trcrn, uvel, vvel, vsnon_init @@ -198,10 +199,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_iage, nt_FY, nt_qice, nt_sice, nt_aero, nt_qsno, & + nt_isosno, nt_isoice logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_aero, tr_pond, tr_pond_cesm, & + tr_iage, tr_FY, tr_iso, tr_aero, tr_pond, tr_pond_cesm, & tr_pond_lvl, tr_pond_topo, calc_Tsfc real (kind=dbl_kind) :: & @@ -210,6 +212,9 @@ subroutine step_therm1 (dt, iblk) real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & aerosno, aeroice ! kg/m^2 + real (kind=dbl_kind), dimension(n_iso,ncat) :: & + isosno, isoice ! kg/m^2 + type (block) :: & this_block ! block information for current block @@ -219,7 +224,7 @@ subroutine step_therm1 (dt, iblk) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags( & - tr_iage_out=tr_iage, tr_FY_out=tr_FY, & + 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) call icepack_query_tracer_indices( & @@ -227,7 +232,8 @@ subroutine step_therm1 (dt, iblk) 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_aero_out=nt_aero, nt_qsno_out=nt_qsno, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -236,6 +242,8 @@ subroutine step_therm1 (dt, iblk) prescribed_ice = .false. #endif + isosno (:,:) = c0 + isoice (:,:) = c0 aerosno(:,:,:) = c0 aeroice(:,:,:) = c0 @@ -270,8 +278,16 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi - if (tr_aero) then - ! trcrn(nt_aero) has units kg/m^3 + if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 + do n=1,ncat + do k=1,n_iso + isosno(k,n) = trcrn(i,j,nt_isosno+k-1,n,iblk) * vsnon_init(i,j,n,iblk) + isoice(k,n) = trcrn(i,j,nt_isoice+k-1,n,iblk) * vicen_init(i,j,n,iblk) + enddo + enddo + endif ! tr_iso + + if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3 do n=1,ncat do k=1,n_aero aerosno (k,:,n) = & @@ -311,15 +327,19 @@ subroutine step_therm1 (dt, iblk) FY = trcrn (i,j,nt_FY ,:,iblk), & aerosno = aerosno (:,:,:), & aeroice = aeroice (:,:,:), & + isosno = isosno (:,:), & + isoice = isoice (:,:), & uatm = uatm (i,j, iblk), & vatm = vatm (i,j, iblk), & wind = wind (i,j, iblk), & zlvl = zlvl (i,j, iblk), & Qa = Qa (i,j, iblk), & + Qa_iso = Qa_iso (i,j,:,iblk), & rhoa = rhoa (i,j, iblk), & Tair = Tair (i,j, iblk), & Tref = Tref (i,j, iblk), & Qref = Qref (i,j, iblk), & + Qref_iso = Qref_iso (i,j,:,iblk), & Uref = Uref (i,j, iblk), & Cdn_atm_ratio= Cdn_atm_ratio(i,j, iblk), & Cdn_ocn = Cdn_ocn (i,j, iblk), & @@ -389,6 +409,12 @@ subroutine step_therm1 (dt, iblk) fcondtopn_f = fcondtopn_f (i,j,:,iblk), & faero_atm = faero_atm (i,j,1:n_aero,iblk), & faero_ocn = faero_ocn (i,j,1:n_aero,iblk), & + fiso_atm = fiso_atm (i,j,:,iblk), & + fiso_ocn = fiso_ocn (i,j,:,iblk), & + fiso_evap = fiso_evap (i,j,:,iblk), & + HDO_ocn = HDO_ocn (i,j, iblk), & + H2_16O_ocn = H2_16O_ocn (i,j, iblk), & + H2_18O_ocn = H2_18O_ocn (i,j, iblk), & dhsn = dhsn (i,j,:,iblk), & ffracn = ffracn (i,j,:,iblk), & meltt = meltt (i,j, iblk), & @@ -408,6 +434,19 @@ subroutine step_therm1 (dt, iblk) frz_onset = frz_onset (i,j, iblk), & yday=yday, prescribed_ice=prescribed_ice) + if (tr_iso) then + do n = 1, ncat + if (vicen(i,j,n,iblk) > puny) & + isoice(:,n) = isoice(:,n)/vicen(i,j,n,iblk) + if (vsnon(i,j,n,iblk) > puny) & + isosno(:,n) = isosno(:,n)/vsnon(i,j,n,iblk) + do k = 1, n_iso + trcrn(i,j,nt_isosno+k-1,n,iblk) = isosno(k,n) + trcrn(i,j,nt_isoice+k-1,n,iblk) = isoice(k,n) + enddo + enddo + endif ! tr_iso + if (tr_aero) then do n = 1, ncat if (vicen(i,j,n,iblk) > puny) & @@ -452,7 +491,8 @@ subroutine step_therm2 (dt, iblk) use ice_flux, only: fresh, frain, fpond, frzmlt, frazil, frz_onset, & update_ocn_f, fsalt, Tf, sss, salinz, fhocn, rside, fside, & meltl, frazil_diag - use ice_flux_bgc, only: flux_bio, faero_ocn + use ice_flux_bgc, only: flux_bio, faero_ocn, & + fiso_ocn, HDO_ocn, H2_16O_ocn, H2_18O_ocn use ice_grid, only: tmask use ice_state, only: aice, aicen, aice0, trcr_depend, & aicen_init, vicen_init, trcrn, vicen, vsnon, & @@ -550,7 +590,12 @@ subroutine step_therm2 (dt, iblk) ocean_bio = ocean_bio (i,j,1:nbtrcr,iblk), & frazil_diag= frazil_diag(i,j,iblk), & frz_onset = frz_onset (i,j, iblk), & - yday = yday, nfsd=nfsd, & + yday = yday, & + fiso_ocn = fiso_ocn (i,j,:,iblk), & + HDO_ocn = HDO_ocn (i,j, iblk), & + H2_16O_ocn = H2_16O_ocn(i,j, iblk), & + H2_18O_ocn = H2_18O_ocn(i,j, iblk), & + nfsd = nfsd, & wave_sig_ht= wave_sig_ht(i,j,iblk), & wave_spectrum = wave_spectrum(i,j,:,iblk), & wavefreq = wavefreq(:), & @@ -820,7 +865,7 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) dvirdgdt, opening, fpond, fresh, fhocn, & aparticn, krdgn, aredistn, vredistn, dardg1ndt, dardg2ndt, & dvirdgndt, araftn, vraftn, fsalt - use ice_flux_bgc, only: flux_bio, faero_ocn + use ice_flux_bgc, only: flux_bio, faero_ocn, fiso_ocn use ice_grid, only: tmask use ice_state, only: trcrn, vsnon, aicen, vicen, & aice, aice0, trcr_depend, n_trcr_strata, & @@ -897,6 +942,7 @@ subroutine step_dyn_ridge (dt, ndtd, iblk) fresh = fresh (i,j, iblk), & fhocn = fhocn (i,j, iblk), & faero_ocn = faero_ocn(i,j,:,iblk), & + fiso_ocn = fiso_ocn (i,j,:,iblk), & aparticn = aparticn (i,j,:,iblk), & krdgn = krdgn (i,j,:,iblk), & aredistn = aredistn (i,j,:,iblk), & diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 3dce5a42e..884ee6331 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -100,19 +100,19 @@ module ice_boundary ! !----------------------------------------------------------------------- - integer (int_kind) :: & + integer (int_kind), public :: & bufSizeSend, &! max buffer size for send messages bufSizeRecv ! max buffer size for recv messages - integer (int_kind), dimension(:,:), allocatable :: & + integer (int_kind), dimension(:,:), allocatable, public :: & bufSendI4, &! buffer for use to send in 2D i4 halo updates bufRecvI4 ! buffer for use to recv in 2D i4 halo updates - real (real_kind), dimension(:,:), allocatable :: & + real (real_kind), dimension(:,:), allocatable, public :: & bufSendR4, &! buffer for use to send in 2D r4 halo updates bufRecvR4 ! buffer for use to recv in 2D r4 halo updates - real (dbl_kind), dimension(:,:), allocatable :: & + real (dbl_kind), dimension(:,:), allocatable, public :: & bufSendR8, &! buffer for use to send in 2D r8 halo updates bufRecvR8 ! buffer for use to recv in 2D r8 halo updates @@ -122,13 +122,13 @@ module ice_boundary ! !----------------------------------------------------------------------- - integer (int_kind), dimension(:,:), allocatable :: & + integer (int_kind), dimension(:,:), allocatable, public :: & bufTripoleI4 - real (real_kind), dimension(:,:), allocatable :: & + real (real_kind), dimension(:,:), allocatable, public :: & bufTripoleR4 - real (dbl_kind), dimension(:,:), allocatable :: & + real (dbl_kind), dimension(:,:), allocatable, public :: & bufTripoleR8 !*********************************************************************** diff --git a/cicecore/cicedynB/infrastructure/ice_blocks.F90 b/cicecore/cicedynB/infrastructure/ice_blocks.F90 index b95ad6acb..5177dd047 100644 --- a/cicecore/cicedynB/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedynB/infrastructure/ice_blocks.F90 @@ -89,15 +89,15 @@ module ice_blocks ! !----------------------------------------------------------------------- - type (block), dimension(:), allocatable :: & + type (block), dimension(:), allocatable, public :: & all_blocks ! block information for all blocks in domain - integer (int_kind), dimension(:,:),allocatable :: & + integer (int_kind), dimension(:,:),allocatable, public :: & all_blocks_ij ! block index stored in Cartesian order ! useful for determining block index ! of neighbor blocks - integer (int_kind), dimension(:,:), allocatable, target :: & + integer (int_kind), dimension(:,:), allocatable, target, public :: & i_global, &! global i index for each point in each block j_global ! global j index for each point in each block @@ -157,10 +157,10 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & ! !---------------------------------------------------------------------- - allocate(all_blocks(nblocks_tot)) - allocate(i_global(nx_block,nblocks_tot), & - j_global(ny_block,nblocks_tot)) - allocate(all_blocks_ij(nblocks_x,nblocks_y)) + if (.not.allocated(all_blocks)) allocate(all_blocks(nblocks_tot)) + if (.not.allocated(i_global)) allocate(i_global(nx_block,nblocks_tot)) + if (.not.allocated(j_global)) allocate(j_global(ny_block,nblocks_tot)) + if (.not.allocated(all_blocks_ij)) allocate(all_blocks_ij(nblocks_x,nblocks_y)) !---------------------------------------------------------------------- ! diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index 51a9eaa69..3be2449f7 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -188,6 +188,7 @@ subroutine init_domain_blocks ( (dble(nx_global-1)/dble(block_size_x + 1)) * & (dble(ny_global-1)/dble(block_size_y + 1)) ) & / dble(nprocs)) + max_blocks=max(1,max_blocks) write(nu_diag,'(/,a52,i6,/)') & '(ice_domain): max_block < 1: max_block estimated to ',max_blocks endif diff --git a/cicecore/cicedynB/infrastructure/ice_restoring.F90 b/cicecore/cicedynB/infrastructure/ice_restoring.F90 index 1ef7b9531..09db9c273 100644 --- a/cicecore/cicedynB/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restoring.F90 @@ -32,12 +32,12 @@ module ice_restoring ! state of the ice for each category !----------------------------------------------------------------- - real (kind=dbl_kind), dimension (:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & aicen_rest , & ! concentration of ice vicen_rest , & ! volume per unit area of ice (m) vsnon_rest ! volume per unit area of snow (m) - real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable :: & + real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, public :: & trcrn_rest ! tracers !======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 index 9e9150b6c..8ecfeb6f1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 @@ -15,10 +15,11 @@ 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 + use ice_fileunits, only: nu_dump_bgc, nu_dump_aero, nu_dump_fsd, nu_dump_iso 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_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_sizes @@ -52,7 +53,7 @@ subroutine init_restart_read(ice_ic) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine character(len=char_len_long) :: & @@ -77,7 +78,7 @@ subroutine init_restart_read(ice_ic) nbtrcr_out=nbtrcr) 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_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -320,6 +321,26 @@ subroutine init_restart_read(ice_ic) endif endif + if (tr_iso) then + if (my_task == master_task) then + n = index(filename0,trim(restart_file)) + if (n == 0) call abort_ice(subname//'ERROR: iso 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)),'.iso', & + string2(1:lenstr(string2)) + if (restart_ext) then + call ice_open_ext(nu_restart_iso,filename,0) + else + call ice_open(nu_restart_iso,filename,0) + endif + read (nu_restart_iso) iignore,rignore,rignore + write(nu_diag,*) 'Reading ',filename(1:lenstr(filename)) + endif + endif + if (tr_aero) then if (my_task == master_task) then n = index(filename0,trim(restart_file)) @@ -366,7 +387,7 @@ subroutine init_restart_write(filename_spec) logical (kind=log_kind) :: & solve_zsal, tr_fsd, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine integer (kind=int_kind) :: & @@ -383,7 +404,7 @@ subroutine init_restart_write(filename_spec) nbtrcr_out=nbtrcr) 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_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -618,6 +639,26 @@ subroutine init_restart_write(filename_spec) endif endif + if (tr_iso) 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)),'.iso.', & + iyear,'-',month,'-',mday,'-',sec + + if (restart_ext) then + call ice_open_ext(nu_dump_iso,filename,0) + else + call ice_open(nu_dump_iso,filename,0) + endif + + if (my_task == master_task) then + write(nu_dump_iso) istep1,time,time_forc + write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) + endif + + endif + if (tr_aero) then write(filename,'(a,a,a,i4.4,a,i2.2,a,i2.2,a,i5.5)') & @@ -767,7 +808,7 @@ subroutine final_restart() logical (kind=log_kind) :: & solve_zsal, & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine integer (kind=int_kind) :: & @@ -781,7 +822,7 @@ subroutine final_restart() nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -790,6 +831,7 @@ subroutine final_restart() if (my_task == master_task) then close(nu_dump) + if (tr_iso) close(nu_dump_iso) if (tr_aero) close(nu_dump_aero) if (tr_iage) close(nu_dump_age) if (tr_FY) close(nu_dump_FY) diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index ecabcc089..d4decf6f7 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -113,7 +113,7 @@ subroutine init_restart_write(filename_spec) time, time_forc, year_init use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & - n_aero, nblyr, n_zaero, n_algae, n_doc, & + n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & n_dic, n_don, n_fed, n_fep, nfsd use ice_arrays_column, only: oceanmixed_ice use ice_dyn_shared, only: kdyn @@ -124,13 +124,13 @@ 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_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & - tr_bgc_chl, tr_bgc_Am, & + tr_bgc_chl, tr_bgc_Am, & tr_bgc_PON, tr_bgc_DON, & - tr_zaero, tr_bgc_Fe, & + tr_zaero, tr_bgc_Fe, & tr_bgc_hum integer (kind=int_kind) :: & @@ -160,7 +160,7 @@ subroutine init_restart_write(filename_spec) nbtrcr_out=nbtrcr) 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_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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_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, & @@ -470,6 +470,14 @@ subroutine init_restart_write(filename_spec) enddo endif + if (tr_iso) then + do k=1,n_iso + write(nchar,'(i3.3)') k + call define_rest_field(ncid,'isosno'//trim(nchar),dims) + call define_rest_field(ncid,'isoice'//trim(nchar),dims) + enddo + endif + if (tr_aero) then do k=1,n_aero write(nchar,'(i3.3)') k diff --git a/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 index 8dc9e94a9..d673c7f7a 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio/ice_restart.F90 @@ -125,7 +125,7 @@ subroutine init_restart_write(filename_spec) time, time_forc, year_init use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & - n_aero, nblyr, n_zaero, n_algae, n_doc, & + n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & n_dic, n_don, n_fed, n_fep use ice_dyn_shared, only: kdyn use ice_arrays_column, only: oceanmixed_ice @@ -134,7 +134,7 @@ subroutine init_restart_write(filename_spec) solve_zsal, skl_bgc, z_tracers logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & @@ -171,7 +171,7 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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_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, & @@ -473,6 +473,14 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'qsno'//trim(nchar),dims) enddo + if (tr_iso) then + do k=1,n_iso + write(nchar,'(i3.3)') k + call define_rest_field(File,'isosno'//nchar, dims) + call define_rest_field(File,'isoice'//nchar, dims) + enddo + endif + if (tr_aero) then do k=1,n_aero 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 8dc9e94a9..d673c7f7a 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -125,7 +125,7 @@ subroutine init_restart_write(filename_spec) time, time_forc, year_init use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & - n_aero, nblyr, n_zaero, n_algae, n_doc, & + n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & n_dic, n_don, n_fed, n_fep use ice_dyn_shared, only: kdyn use ice_arrays_column, only: oceanmixed_ice @@ -134,7 +134,7 @@ subroutine init_restart_write(filename_spec) solve_zsal, skl_bgc, z_tracers logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_aero, tr_pond_cesm, & + tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_pond_cesm, & tr_pond_topo, tr_pond_lvl, tr_brine, & tr_bgc_N, tr_bgc_C, tr_bgc_Nit, & tr_bgc_Sil, tr_bgc_DMS, & @@ -171,7 +171,7 @@ subroutine init_restart_write(filename_spec) call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, & - tr_aero_out=tr_aero, tr_pond_cesm_out=tr_pond_cesm, & + 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_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, & @@ -473,6 +473,14 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'qsno'//trim(nchar),dims) enddo + if (tr_iso) then + do k=1,n_iso + write(nchar,'(i3.3)') k + call define_rest_field(File,'isosno'//nchar, dims) + call define_rest_field(File,'isoice'//nchar, dims) + enddo + endif + if (tr_aero) then do k=1,n_aero write(nchar,'(i3.3)') k diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index b5d2608a3..b72745e30 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -77,7 +77,7 @@ subroutine cice_init(mpicom_ice) use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc + faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -95,7 +95,7 @@ subroutine cice_init(mpicom_ice) mpicom_ice ! communicator for sequential ccsm logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' call init_communicate(mpicom_ice) ! initial setup for message passing @@ -122,7 +122,6 @@ subroutine cice_init(mpicom_ice) call ice_timer_start(timer_total) ! start timing entire run call init_grid2 ! grid variables call init_zbgc ! vertical biogeochemistry initialization - call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file @@ -134,6 +133,7 @@ subroutine cice_init(mpicom_ice) endif call init_coupler_flux ! initialize fluxes exchanged with coupler + #ifdef popcice call sst_sss ! POP data for CICE initialization #endif @@ -181,6 +181,7 @@ subroutine cice_init(mpicom_ice) call init_history_dyn ! initialize dynamic history variables 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_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -211,6 +212,8 @@ subroutine cice_init(mpicom_ice) call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -239,20 +242,21 @@ subroutine init_restart use ice_calendar, only: time, calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & - init_aerosol, init_hbrine, init_bgc, init_fsd + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_cesm, read_restart_pond_cesm, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_zsal, restart_bgc @@ -265,13 +269,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_aero, tr_brine, & + tr_pond_topo, 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_iage, nt_FY, nt_aero, nt_fsd + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -285,10 +289,11 @@ 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_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_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -393,6 +398,20 @@ subroutine init_restart call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) endif endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + if (tr_aero) then ! ice aerosol if (trim(runtype) == 'continue') restart_aero = .true. if (restart_aero) then diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index 26d40a431..09cffa0c7 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -22,7 +22,7 @@ module CICE_RunMod use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes @@ -48,12 +48,12 @@ subroutine CICE_Run use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default + fiso_default, faero_default use ice_flux, only: init_flux_atm, init_flux_ocn use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_couple, timer_step logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' !-------------------------------------------------------------------- @@ -65,7 +65,8 @@ subroutine CICE_Run call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & tr_zaero_out=tr_zaero, & tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -95,6 +96,8 @@ subroutine CICE_Run call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -150,7 +153,7 @@ 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_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine 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, & @@ -172,7 +175,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & + 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 character(len=*), parameter :: subname = '(ice_step)' @@ -183,7 +186,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_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -236,7 +239,7 @@ subroutine ice_step if (.not.prescribed_ice) & call step_therm2 (dt, iblk) ! ice thickness distribution thermo - endif + endif ! ktherm > 0 enddo ! iblk !$OMP END PARALLEL DO @@ -335,6 +338,7 @@ subroutine ice_step if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & call write_restart_bgc @@ -369,7 +373,8 @@ subroutine coupling_prep (iblk) swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask @@ -552,7 +557,8 @@ subroutine coupling_prep (iblk) !----------------------------------------------------------------- call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & aice (:,:,iblk), Tf (:,:,iblk), & Tair (:,:,iblk), Qa (:,:,iblk), & strairxT (:,:,iblk), strairyT(:,:,iblk), & @@ -566,7 +572,10 @@ subroutine coupling_prep (iblk) alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk), & Uref=Uref(:,:,iblk), wind=wind(:,:,iblk) ) !----------------------------------------------------------------- diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90_debug b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90_debug deleted file mode 100644 index 4f8b0a352..000000000 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90_debug +++ /dev/null @@ -1,696 +0,0 @@ -!======================================================================= -! -! Main driver for time stepping of CICE. -! -! authors Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL -! -! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep -! 2006 ECH: Streamlined for efficiency -! 2006 ECH: Converted to free source form (F90) -! 2007 BPB: Modified Delta-Eddington shortwave interface -! 2008 ECH: moved ESMF code to its own driver - - module CICE_RunMod - - use ice_kinds_mod - use perf_mod, only : t_startf, t_stopf, t_barrierf - use ice_fileunits, only: nu_diag - use ice_arrays_column, only: oceanmixed_ice - use ice_constants, only: c0, c1 - use ice_constants, only: field_loc_center, field_type_scalar - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_numbers - - implicit none - private - public :: CICE_Run, ice_step - -!======================================================================= - - contains - -!======================================================================= -! -! This is the main driver routine for advancing CICE forward in time. -! -! author Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL - - subroutine CICE_Run - - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar - use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, atm_data_type - use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default - use ice_flux, only: init_flux_atm, init_flux_ocn - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_couple, timer_step - - logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers - character(len=*), parameter :: subname = '(CICE_Run)' - - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- - - call ice_timer_start(timer_step) ! start timing entire run - - call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- - -! timeLoop: do - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call ice_timer_start(timer_couple) ! atm/ocn coupling - -#ifndef coupled -#ifndef CESMCOUPLED - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif - if (z_tracers) call get_atm_bgc ! biogeochemistry - - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - call calendar(time) ! at the end of the timestep - - call ice_timer_stop(timer_couple) ! atm/ocn coupling - - call ice_step - -! if (stop_now >= 1) exit timeLoop -! enddo timeLoop - - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- - - call ice_timer_stop(timer_step) ! end timestepping loop timer - - end subroutine CICE_Run - -!======================================================================= -! -! Calls drivers for physics components, some initialization, and output -! -! author Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL - - subroutine ice_step - - use ice_boundary, only: ice_HaloUpdate - use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, sec - use ice_diagnostics, only: init_mass_diags, runtime_diags - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags - use ice_domain, only: halo_info, nblocks - use ice_dyn_eap, only: write_restart_eap - use ice_dyn_shared, only: kdyn, kridge - use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd - use ice_history, only: accum_hist - use ice_history_bgc, only: init_history_bgc - use ice_restart, only: final_restart - use ice_restart_column, only: write_restart_age, write_restart_FY, & - write_restart_lvl, write_restart_pond_cesm, write_restart_pond_lvl, & - write_restart_pond_topo, write_restart_aero, & - write_restart_bgc, write_restart_hbrine - 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 - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_diags, timer_column, timer_thermo, timer_bound, & - timer_hist, timer_readwrite - use ice_communicate, only: MPI_COMM_ICE - use ice_prescribed_mod - - integer (kind=int_kind) :: & - iblk , & ! block index - k , & ! dynamics supercycling index - ktherm ! thermodynamics is off when ktherm = -1 - - real (kind=dbl_kind) :: & - offset ! d(age)/dt time offset - - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers - - character(len=*), parameter :: subname = '(ice_step)' - - character (len=char_len) :: plabeld - - plabeld = 'beginning time step' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm) - 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) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! restoring on grid boundaries - !----------------------------------------------------------------- - - if (restore_ice) call ice_HaloRestore - - !----------------------------------------------------------------- - ! initialize diagnostics and save initial state values - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics/history - call init_mass_diags ! diagnostics per timestep - call init_history_therm - call init_history_bgc - call ice_timer_stop(timer_diags) ! diagnostics/history - - if (prescribed_ice) then ! read prescribed ice - call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) - call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) - call t_stopf ('cice_run_presc') - endif - - call save_init - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) then - - !----------------------------------------------------------------- - ! scale radiation fields - !----------------------------------------------------------------- - - if (calc_Tsfc) call prep_radiation (iblk) - - plabeld = 'post prep_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! thermodynamics and biogeochemistry - !----------------------------------------------------------------- - - call step_therm1 (dt, iblk) ! vertical thermodynamics - - plabeld = 'post step_therm1' - call debug_ice (iblk, plabeld) - - call biogeochemistry (dt, iblk) ! biogeochemistry - - plabeld = 'post biogeochemistry' - call debug_ice (iblk, plabeld) - - if (.not.prescribed_ice) & - call step_therm2 (dt, iblk) ! ice thickness distribution thermo - - plabeld = 'post step_therm2' - call debug_ice (iblk, plabeld) - - endif - - enddo ! iblk - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! dynamics, transport, ridging - !----------------------------------------------------------------- - - if (.not.prescribed_ice) then - do k = 1, ndtd - - ! momentum, stress, transport - call step_dyn_horiz (dt_dyn) - - plabeld = 'post step_dyn_horiz' - call debug_ice (iblk, plabeld) - - ! ridging - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) - enddo - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) - - enddo - - plabeld = 'post dynamics' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - endif - - !----------------------------------------------------------------- - ! albedo, shortwave radiation - !----------------------------------------------------------------- - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) call step_radiation (dt, iblk) - - plabeld = 'post step_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! get ready for coupling and the next time step - !----------------------------------------------------------------- - - call coupling_prep (iblk) - - plabeld = 'post coupling_prep' - call debug_ice (iblk, plabeld) - - enddo ! iblk - !$OMP END PARALLEL DO - - call ice_timer_start(timer_bound) - call ice_HaloUpdate (scale_factor, halo_info, & - field_loc_center, field_type_scalar) - call ice_timer_stop(timer_bound) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! write data - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics - if (mod(istep,diagfreq) == 0) then - call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags - if (skl_bgc .or. z_tracers) call bgc_diags - if (tr_brine) call hbrine_diags - endif - call ice_timer_stop(timer_diags) ! diagnostics - - call ice_timer_start(timer_hist) ! history - call accum_hist (dt) ! history file - call ice_timer_stop(timer_hist) ! history - - call ice_timer_start(timer_readwrite) ! reading/writing - if (write_restart == 1) then - call dumpfile ! core variables for restarting - if (tr_iage) call write_restart_age - if (tr_FY) call write_restart_FY - if (tr_lvl) call write_restart_lvl - if (tr_pond_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_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & - call write_restart_bgc - if (tr_brine) call write_restart_hbrine - if (kdyn == 2) call write_restart_eap - call final_restart - endif - - call ice_timer_stop(timer_readwrite) ! reading/writing - - end subroutine ice_step - -!======================================================================= -! -! Prepare for coupling -! -! authors: Elizabeth C. Hunke, LANL - - subroutine coupling_prep (iblk) - - use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn - use ice_blocks, only: nx_block, ny_block, get_block, block - use ice_domain, only: blocks_ice - use ice_calendar, only: dt, nstreams - use ice_domain_size, only: ncat - use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & - albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & - alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & - fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & - swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & - fsens, flat, fswabs, flwout, evap, Tref, Qref, & - scale_fluxes, frzmlt_init, frzmlt, Uref, wind, fsurfn_f, flatn_f - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & - fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & - fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn - use ice_grid, only: tmask - use ice_state, only: aicen, aice, aice_init - use ice_step_mod, only: ocean_mixed_layer - use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop - - integer (kind=int_kind), intent(in) :: & - iblk ! block index - - ! local variables - - integer (kind=int_kind) :: & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - n , & ! thickness category index - i,j , & ! horizontal indices - k , & ! tracer index - nbtrcr ! - - type (block) :: & - this_block ! block information for current block - - logical (kind=log_kind) :: & - skl_bgc , & ! - calc_Tsfc ! - - real (kind=dbl_kind) :: & - cszn , & ! counter for history averaging - puny , & ! - rhofresh , & ! - netsw ! flag for shortwave radiation presence - - character(len=*), parameter :: subname = '(coupling_prep)' - - !----------------------------------------------------------------- - - call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) - call icepack_query_parameters(skl_bgc_out=skl_bgc) - call icepack_query_tracer_numbers(nbtrcr_out=nbtrcr) - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! Save current value of frzmlt for diagnostics. - ! Update mixed layer with heat and radiation from ice. - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) - enddo - enddo - - call ice_timer_start(timer_couple,iblk) ! atm/ocn coupling - - if (oceanmixed_ice) & - call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst - - !----------------------------------------------------------------- - ! Aggregate albedos - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = c0 - alidf(i,j,iblk) = c0 - alvdr(i,j,iblk) = c0 - alidr(i,j,iblk) = c0 - - albice(i,j,iblk) = c0 - albsno(i,j,iblk) = c0 - albpnd(i,j,iblk) = c0 - apeff_ai(i,j,iblk) = c0 - snowfrac(i,j,iblk) = c0 - - ! for history averaging - cszn = c0 - netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) - if (netsw > puny) cszn = c1 - do n = 1, nstreams - albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn - enddo - enddo - enddo - - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do n = 1, ncat - do j = jlo, jhi - do i = ilo, ihi - if (aicen(i,j,n,iblk) > puny) then - - alvdf(i,j,iblk) = alvdf(i,j,iblk) & - + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidf(i,j,iblk) = alidf(i,j,iblk) & - + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alvdr(i,j,iblk) = alvdr(i,j,iblk) & - + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidr(i,j,iblk) = alidr(i,j,iblk) & - + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - - netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & - + swvdf(i,j,iblk) + swidf(i,j,iblk) - if (netsw > puny) then ! sun above horizon - albice(i,j,iblk) = albice(i,j,iblk) & - + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) - albsno(i,j,iblk) = albsno(i,j,iblk) & - + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) - albpnd(i,j,iblk) = albpnd(i,j,iblk) & - + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) - endif - - apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history - + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) - snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history - + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - - endif ! aicen > puny - enddo - enddo - enddo - - do j = 1, ny_block - do i = 1, nx_block - - !----------------------------------------------------------------- - ! reduce fresh by fpond for coupling - !----------------------------------------------------------------- - - if (l_mpond_fresh) then - fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt - fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) - endif - - !---------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !---------------------------------------------------------------- - - alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) - alidf_ai (i,j,iblk) = alidf (i,j,iblk) - alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) - alidr_ai (i,j,iblk) = alidr (i,j,iblk) - fresh_ai (i,j,iblk) = fresh (i,j,iblk) - fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) - fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) - fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) - - if (nbtrcr > 0) then - do k = 1, nbtrcr - flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) - enddo - endif - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in scale_factor - !----------------------------------------------------------------- - scale_factor(i,j,iblk) = & - swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & - + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & - + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & - + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) - - enddo - enddo - - !----------------------------------------------------------------- - ! Divide fluxes by ice area - ! - the CESM coupler assumes fluxes are per unit ice area - ! - also needed for global budget in diagnostics - !----------------------------------------------------------------- - - call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & - aice (:,:,iblk), Tf (:,:,iblk), & - Tair (:,:,iblk), Qa (:,:,iblk), & - strairxT (:,:,iblk), strairyT(:,:,iblk), & - fsens (:,:,iblk), flat (:,:,iblk), & - fswabs (:,:,iblk), flwout (:,:,iblk), & - evap (:,:,iblk), & - Tref (:,:,iblk), Qref (:,:,iblk), & - fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & - faero_ocn(:,:,:,iblk), & - alvdr (:,:,iblk), alidr (:,:,iblk), & - alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk), & - Uref=Uref(:,:,iblk), wind=wind(:,:,iblk) ) - - !----------------------------------------------------------------- - ! Define ice-ocean bgc fluxes - !----------------------------------------------------------------- - - if (nbtrcr > 0 .or. skl_bgc) then - call bgcflux_ice_to_ocn (nx_block, ny_block, & - flux_bio(:,:,1:nbtrcr,iblk), & - fnit(:,:,iblk), fsil(:,:,iblk), & - famm(:,:,iblk), fdmsp(:,:,iblk), & - fdms(:,:,iblk), fhum(:,:,iblk), & - fdust(:,:,iblk), falgalN(:,:,:,iblk), & - fdoc(:,:,:,iblk), fdic(:,:,:,iblk), & - fdon(:,:,:,iblk), ffep(:,:,:,iblk), & - ffed(:,:,:,iblk)) - endif - -!echmod - comment this out for efficiency, if .not. calc_Tsfc - if (.not. calc_Tsfc) then - - !--------------------------------------------------------------- - ! If surface fluxes were provided, conserve these fluxes at ice - ! free points by passing to ocean. - !--------------------------------------------------------------- - - call sfcflux_to_ocn & - (nx_block, ny_block, & - tmask (:,:,iblk), aice_init(:,:,iblk), & - fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & - fresh (:,:,iblk), fhocn (:,:,iblk)) - endif -!echmod - - call ice_timer_stop(timer_couple,iblk) ! atm/ocn coupling - - end subroutine coupling_prep - -!======================================================================= -! -! If surface heat fluxes are provided to CICE instead of CICE calculating -! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can -! be provided at points which do not have ice. (This is could be due to -! the heat fluxes being calculated on a lower resolution grid or the -! heat fluxes not recalculated at every CICE timestep.) At ice free points, -! conserve energy and water by passing these fluxes to the ocean. -! -! author: A. McLaren, Met Office - - subroutine sfcflux_to_ocn(nx_block, ny_block, & - tmask, aice, & - fsurfn_f, flatn_f, & - fresh, fhocn) - - use ice_domain_size, only: ncat - - integer (kind=int_kind), intent(in) :: & - nx_block, ny_block ! block dimensions - - logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & - tmask ! land/boundary mask, thickness (T-cell) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & - aice ! initial ice concentration - - real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & - fsurfn_f, & ! net surface heat flux (provided as forcing) - flatn_f ! latent heat flux (provided as forcing) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & - fresh , & ! fresh water flux to ocean (kg/m2/s) - fhocn ! actual ocn/ice heat flx (W/m**2) - -#ifdef CICE_IN_NEMO - - ! local variables - integer (kind=int_kind) :: & - i, j, n ! horizontal indices - - real (kind=dbl_kind) :: & - puny, & ! - rLsub ! 1/Lsub - - character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - - 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__) - rLsub = c1 / Lsub - - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j) .and. aice(i,j) <= puny) then - fhocn(i,j) = fhocn(i,j) & - + fsurfn_f(i,j,n) + flatn_f(i,j,n) - fresh(i,j) = fresh(i,j) & - + flatn_f(i,j,n) * rLsub - endif - enddo ! i - enddo ! j - enddo ! n - -#endif - - end subroutine sfcflux_to_ocn - -!======================================================================= - - end module CICE_RunMod - -!======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index cb3e7bb98..b72745e30 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -77,7 +77,7 @@ subroutine cice_init(mpicom_ice) use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc + faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -95,7 +95,7 @@ subroutine cice_init(mpicom_ice) mpicom_ice ! communicator for sequential ccsm logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' call init_communicate(mpicom_ice) ! initial setup for message passing @@ -122,7 +122,6 @@ subroutine cice_init(mpicom_ice) call ice_timer_start(timer_total) ! start timing entire run call init_grid2 ! grid variables call init_zbgc ! vertical biogeochemistry initialization - call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file @@ -134,6 +133,7 @@ subroutine cice_init(mpicom_ice) endif call init_coupler_flux ! initialize fluxes exchanged with coupler + #ifdef popcice call sst_sss ! POP data for CICE initialization #endif @@ -181,6 +181,7 @@ subroutine cice_init(mpicom_ice) call init_history_dyn ! initialize dynamic history variables 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_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -194,6 +195,11 @@ subroutine cice_init(mpicom_ice) if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the first timestep + !-------------------------------------------------------------------- ! coupler communication or forcing data initialization !-------------------------------------------------------------------- @@ -206,6 +212,8 @@ subroutine cice_init(mpicom_ice) call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -234,20 +242,21 @@ subroutine init_restart use ice_calendar, only: time, calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & - init_aerosol, init_hbrine, init_bgc, init_fsd + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_cesm, read_restart_pond_cesm, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_zsal, restart_bgc @@ -260,13 +269,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_aero, tr_brine, & + tr_pond_topo, 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_iage, nt_FY, nt_aero, nt_fsd + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -280,10 +289,11 @@ 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_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_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -388,6 +398,20 @@ subroutine init_restart call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) endif endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + if (tr_aero) then ! ice aerosol if (trim(runtype) == 'continue') restart_aero = .true. if (restart_aero) then diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 26d40a431..09cffa0c7 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -22,7 +22,7 @@ module CICE_RunMod use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes @@ -48,12 +48,12 @@ subroutine CICE_Run use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default + fiso_default, faero_default use ice_flux, only: init_flux_atm, init_flux_ocn use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_couple, timer_step logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' !-------------------------------------------------------------------- @@ -65,7 +65,8 @@ subroutine CICE_Run call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & tr_zaero_out=tr_zaero, & tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -95,6 +96,8 @@ subroutine CICE_Run call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -150,7 +153,7 @@ 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_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine 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, & @@ -172,7 +175,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & + 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 character(len=*), parameter :: subname = '(ice_step)' @@ -183,7 +186,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_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -236,7 +239,7 @@ subroutine ice_step if (.not.prescribed_ice) & call step_therm2 (dt, iblk) ! ice thickness distribution thermo - endif + endif ! ktherm > 0 enddo ! iblk !$OMP END PARALLEL DO @@ -335,6 +338,7 @@ subroutine ice_step if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & call write_restart_bgc @@ -369,7 +373,8 @@ subroutine coupling_prep (iblk) swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask @@ -552,7 +557,8 @@ subroutine coupling_prep (iblk) !----------------------------------------------------------------- call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & aice (:,:,iblk), Tf (:,:,iblk), & Tair (:,:,iblk), Qa (:,:,iblk), & strairxT (:,:,iblk), strairyT(:,:,iblk), & @@ -566,7 +572,10 @@ subroutine coupling_prep (iblk) alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk), & + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk), & Uref=Uref(:,:,iblk), wind=wind(:,:,iblk) ) !----------------------------------------------------------------- diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index fd9449efd..986189f96 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -16,8 +16,8 @@ module CICE_InitMod use ice_exit, only: abort_ice use ice_fileunits, only: init_fileunits, nu_diag use icepack_intfc, only: icepack_aggregate - use icepack_intfc, only: icepack_init_fsd_bounds, icepack_init_wave 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_configure use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_flags, & @@ -49,6 +49,7 @@ subroutine CICE_Initialize(mpi_comm) !-------------------------------------------------------------------- ! model initialization !-------------------------------------------------------------------- + if (present(mpi_comm)) then call cice_init(mpi_comm) else @@ -81,7 +82,7 @@ subroutine cice_init(mpi_comm) use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc + faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -94,11 +95,14 @@ subroutine cice_init(mpi_comm) #ifdef popcice use drv_forcing, only: sst_sss #endif + integer (kind=int_kind), optional, intent(in) :: & - mpi_comm ! communicator for sequential ccsm + mpi_comm ! communicator for sequential ccsm + logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' + if (present(mpi_comm)) then call init_communicate(mpi_comm) ! initial setup for message passing else @@ -130,7 +134,6 @@ subroutine cice_init(mpi_comm) call ice_timer_start(timer_total) ! start timing entire run call init_grid2 ! grid variables call init_zbgc ! vertical biogeochemistry initialization - call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file @@ -142,6 +145,7 @@ subroutine cice_init(mpi_comm) endif call init_coupler_flux ! initialize fluxes exchanged with coupler + #ifdef popcice call sst_sss ! POP data for CICE initialization #endif @@ -189,6 +193,7 @@ subroutine cice_init(mpi_comm) call init_history_dyn ! initialize dynamic history variables 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_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -220,6 +225,9 @@ subroutine cice_init(mpi_comm) #ifndef CICE_DMI call get_forcing_ocn(dt) ! ocean forcing from data #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) @@ -248,20 +256,21 @@ subroutine init_restart use ice_calendar, only: time, calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & - init_aerosol, init_hbrine, init_bgc, init_fsd + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_cesm, read_restart_pond_cesm, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_zsal, restart_bgc @@ -274,13 +283,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_aero, tr_brine, & + tr_pond_topo, 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_iage, nt_FY, nt_aero, nt_fsd + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -294,10 +303,11 @@ 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_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_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -402,6 +412,20 @@ subroutine init_restart call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) endif endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + if (tr_aero) then ! ice aerosol if (trim(runtype) == 'continue') restart_aero = .true. if (restart_aero) then diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index 11587cd83..ad575f714 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -21,7 +21,7 @@ module CICE_RunMod use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes @@ -47,12 +47,12 @@ subroutine CICE_Run use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default + fiso_default, faero_default use ice_flux, only: init_flux_atm, init_flux_ocn use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_couple, timer_step logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' !-------------------------------------------------------------------- @@ -64,7 +64,8 @@ subroutine CICE_Run call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & tr_zaero_out=tr_zaero, & tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -103,6 +104,9 @@ subroutine CICE_Run #ifndef CICE_DMI call get_forcing_ocn(dt) ! ocean forcing from data #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) @@ -155,7 +159,7 @@ 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_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine 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, & @@ -175,7 +179,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & + 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 character(len=*), parameter :: subname = '(ice_step)' @@ -186,7 +190,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_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -231,7 +235,7 @@ subroutine ice_step call biogeochemistry (dt, iblk) ! biogeochemistry call step_therm2 (dt, iblk) ! ice thickness distribution thermo - endif + endif ! ktherm > 0 enddo ! iblk !$OMP END PARALLEL DO @@ -326,6 +330,7 @@ subroutine ice_step if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & call write_restart_bgc @@ -360,7 +365,8 @@ subroutine coupling_prep (iblk) swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -539,7 +545,8 @@ subroutine coupling_prep (iblk) !----------------------------------------------------------------- call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & aice (:,:,iblk), Tf (:,:,iblk), & Tair (:,:,iblk), Qa (:,:,iblk), & strairxT (:,:,iblk), strairyT(:,:,iblk), & @@ -553,7 +560,10 @@ subroutine coupling_prep (iblk) alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk)) + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk)) #ifdef CICE_IN_NEMO !echmod - comment this out for efficiency, if .not. calc_Tsfc diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90_debug b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90_debug deleted file mode 100644 index 5de6b1cfd..000000000 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90_debug +++ /dev/null @@ -1,686 +0,0 @@ -!======================================================================= -! -! Main driver for time stepping of CICE. -! -! authors Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL -! -! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep -! 2006 ECH: Streamlined for efficiency -! 2006 ECH: Converted to free source form (F90) -! 2007 BPB: Modified Delta-Eddington shortwave interface -! 2008 ECH: moved ESMF code to its own driver - - module CICE_RunMod - - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_arrays_column, only: oceanmixed_ice - use ice_constants, only: c0, c1 - use ice_constants, only: field_loc_center, field_type_scalar - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_numbers - - implicit none - private - public :: CICE_Run, ice_step - -!======================================================================= - - contains - -!======================================================================= -! -! This is the main driver routine for advancing CICE forward in time. -! -! author Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL - - subroutine CICE_Run - - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar - use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & - get_wave_spec - use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default - use ice_flux, only: init_flux_atm, init_flux_ocn - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_couple, timer_step - logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd - character(len=*), parameter :: subname = '(CICE_Run)' - - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- - - call ice_timer_start(timer_step) ! start timing entire run - - call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & - tr_zaero_out=tr_zaero, & - tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - -#ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- - - timeLoop: do -#endif - - call ice_step - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep - -#ifndef CICE_IN_NEMO - if (stop_now >= 1) exit timeLoop -#endif - - call ice_timer_start(timer_couple) ! atm/ocn coupling - -#ifndef coupled -#ifndef CESMCOUPLED -! for now, wave_spectrum is constant in time -! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif - if (z_tracers) call get_atm_bgc ! biogeochemistry - - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - call ice_timer_stop(timer_couple) ! atm/ocn coupling - -#ifndef CICE_IN_NEMO - enddo timeLoop -#endif - - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- - - call ice_timer_stop(timer_step) ! end timestepping loop timer - - end subroutine CICE_Run - -!======================================================================= -! -! Calls drivers for physics components, some initialization, and output -! -! author Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL - - subroutine ice_step - - use ice_boundary, only: ice_HaloUpdate - use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_diagnostics, only: init_mass_diags, runtime_diags - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags - use ice_domain, only: halo_info, nblocks - use ice_dyn_eap, only: write_restart_eap - use ice_dyn_shared, only: kdyn, kridge - use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd - use ice_history, only: accum_hist - use ice_history_bgc, only: init_history_bgc - use ice_restart, only: final_restart - use ice_restart_column, only: write_restart_age, write_restart_FY, & - write_restart_lvl, write_restart_pond_cesm, write_restart_pond_lvl, & - write_restart_pond_topo, write_restart_aero, write_restart_fsd, & - write_restart_bgc, write_restart_hbrine - 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 - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_diags, timer_column, timer_thermo, timer_bound, & - timer_hist, timer_readwrite - - integer (kind=int_kind) :: & - iblk , & ! block index - k , & ! dynamics supercycling index - ktherm ! thermodynamics is off when ktherm = -1 - - real (kind=dbl_kind) :: & - offset ! d(age)/dt time offset - - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec - - character(len=*), parameter :: subname = '(ice_step)' - - character (len=char_len) :: plabeld - - plabeld = 'beginning time step' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_pond_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_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! restoring on grid boundaries - !----------------------------------------------------------------- - - if (restore_ice) call ice_HaloRestore - - !----------------------------------------------------------------- - ! initialize diagnostics and save initial state values - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics/history - call init_mass_diags ! diagnostics per timestep - call init_history_therm - call init_history_bgc - call ice_timer_stop(timer_diags) ! diagnostics/history - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - call save_init - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) then - - !----------------------------------------------------------------- - ! scale radiation fields - !----------------------------------------------------------------- - - if (calc_Tsfc) call prep_radiation (iblk) - - plabeld = 'post prep_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! thermodynamics and biogeochemistry - !----------------------------------------------------------------- - - call step_therm1 (dt, iblk) ! vertical thermodynamics - - plabeld = 'post step_therm1' - call debug_ice (iblk, plabeld) - - call biogeochemistry (dt, iblk) ! biogeochemistry - - plabeld = 'post biogeochemistry' - call debug_ice (iblk, plabeld) - - call step_therm2 (dt, iblk) ! ice thickness distribution thermo - - plabeld = 'post step_therm2' - call debug_ice (iblk, plabeld) - - endif - - enddo ! iblk - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! dynamics, transport, ridging - !----------------------------------------------------------------- - - ! wave fracture of the floe size distribution - ! note this is called outside of the dynamics subcycling loop - if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) - - do k = 1, ndtd - - ! momentum, stress, transport - call step_dyn_horiz (dt_dyn) - - plabeld = 'post step_dyn_horiz' - call debug_ice (iblk, plabeld) - - ! ridging - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) - enddo - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) - - enddo - - plabeld = 'post dynamics' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - !----------------------------------------------------------------- - ! albedo, shortwave radiation - !----------------------------------------------------------------- - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - -!MHRI: CHECK THIS OMP - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) call step_radiation (dt, iblk) - - plabeld = 'post step_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! get ready for coupling and the next time step - !----------------------------------------------------------------- - - call coupling_prep (iblk) - - plabeld = 'post coupling_prep' - call debug_ice (iblk, plabeld) - - enddo ! iblk - !$OMP END PARALLEL DO - - call ice_timer_start(timer_bound) - call ice_HaloUpdate (scale_factor, halo_info, & - field_loc_center, field_type_scalar) - call ice_timer_stop(timer_bound) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! write data - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics - if (mod(istep,diagfreq) == 0) then - call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags - if (skl_bgc .or. z_tracers) call bgc_diags - if (tr_brine) call hbrine_diags - endif - call ice_timer_stop(timer_diags) ! diagnostics - - call ice_timer_start(timer_hist) ! history - call accum_hist (dt) ! history file - call ice_timer_stop(timer_hist) ! history - - call ice_timer_start(timer_readwrite) ! reading/writing - if (write_restart == 1) then - call dumpfile ! core variables for restarting - if (tr_iage) call write_restart_age - if (tr_FY) call write_restart_FY - if (tr_lvl) call write_restart_lvl - if (tr_pond_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_fsd) call write_restart_fsd - if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & - call write_restart_bgc - if (tr_brine) call write_restart_hbrine - if (kdyn == 2) call write_restart_eap - call final_restart - endif - - call ice_timer_stop(timer_readwrite) ! reading/writing - - end subroutine ice_step - -!======================================================================= -! -! Prepare for coupling -! -! authors: Elizabeth C. Hunke, LANL - - subroutine coupling_prep (iblk) - - use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn - use ice_blocks, only: nx_block, ny_block, get_block, block - use ice_domain, only: blocks_ice - use ice_calendar, only: dt, nstreams - use ice_domain_size, only: ncat - use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & - albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & - alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & - fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & - swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & - fsens, flat, fswabs, flwout, evap, Tref, Qref, & - scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai - use ice_grid, only: tmask - use ice_state, only: aicen, aice -#ifdef CICE_IN_NEMO - use ice_state, only: aice_init - use ice_flux, only: flatn_f, fsurfn_f -#endif - use ice_step_mod, only: ocean_mixed_layer - use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop - - integer (kind=int_kind), intent(in) :: & - iblk ! block index - - ! local variables - - integer (kind=int_kind) :: & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - n , & ! thickness category index - i,j , & ! horizontal indices - k , & ! tracer index - nbtrcr ! - - type (block) :: & - this_block ! block information for current block - - logical (kind=log_kind) :: & - calc_Tsfc ! - - real (kind=dbl_kind) :: & - cszn , & ! counter for history averaging - puny , & ! - rhofresh , & ! - netsw ! flag for shortwave radiation presence - - character(len=*), parameter :: subname = '(coupling_prep)' - - call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) - call icepack_query_tracer_numbers(nbtrcr_out=nbtrcr) - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! Save current value of frzmlt for diagnostics. - ! Update mixed layer with heat and radiation from ice. - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) - enddo - enddo - - call ice_timer_start(timer_couple) ! atm/ocn coupling - - if (oceanmixed_ice) & - call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst - - !----------------------------------------------------------------- - ! Aggregate albedos - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = c0 - alidf(i,j,iblk) = c0 - alvdr(i,j,iblk) = c0 - alidr(i,j,iblk) = c0 - - albice(i,j,iblk) = c0 - albsno(i,j,iblk) = c0 - albpnd(i,j,iblk) = c0 - apeff_ai(i,j,iblk) = c0 - snowfrac(i,j,iblk) = c0 - - ! for history averaging - cszn = c0 - netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) - if (netsw > puny) cszn = c1 - do n = 1, nstreams - albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn - enddo - enddo - enddo - - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do n = 1, ncat - do j = jlo, jhi - do i = ilo, ihi - if (aicen(i,j,n,iblk) > puny) then - - alvdf(i,j,iblk) = alvdf(i,j,iblk) & - + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidf(i,j,iblk) = alidf(i,j,iblk) & - + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alvdr(i,j,iblk) = alvdr(i,j,iblk) & - + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidr(i,j,iblk) = alidr(i,j,iblk) & - + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - - netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & - + swvdf(i,j,iblk) + swidf(i,j,iblk) - if (netsw > puny) then ! sun above horizon - albice(i,j,iblk) = albice(i,j,iblk) & - + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) - albsno(i,j,iblk) = albsno(i,j,iblk) & - + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) - albpnd(i,j,iblk) = albpnd(i,j,iblk) & - + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) - endif - - apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history - + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) - snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history - + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - - endif ! aicen > puny - enddo - enddo - enddo - - do j = 1, ny_block - do i = 1, nx_block - - !----------------------------------------------------------------- - ! reduce fresh by fpond for coupling - !----------------------------------------------------------------- - - if (l_mpond_fresh) then - fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt - fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) - endif - - !---------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !---------------------------------------------------------------- - - alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) - alidf_ai (i,j,iblk) = alidf (i,j,iblk) - alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) - alidr_ai (i,j,iblk) = alidr (i,j,iblk) - fresh_ai (i,j,iblk) = fresh (i,j,iblk) - fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) - fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) - fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) - - if (nbtrcr > 0) then - do k = 1, nbtrcr - flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) - enddo - endif - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in scale_factor - !----------------------------------------------------------------- - scale_factor(i,j,iblk) = & - swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & - + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & - + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & - + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) - - enddo - enddo - - !----------------------------------------------------------------- - ! Divide fluxes by ice area - ! - the CESM coupler assumes fluxes are per unit ice area - ! - also needed for global budget in diagnostics - !----------------------------------------------------------------- - - call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & - aice (:,:,iblk), Tf (:,:,iblk), & - Tair (:,:,iblk), Qa (:,:,iblk), & - strairxT (:,:,iblk), strairyT(:,:,iblk), & - fsens (:,:,iblk), flat (:,:,iblk), & - fswabs (:,:,iblk), flwout (:,:,iblk), & - evap (:,:,iblk), & - Tref (:,:,iblk), Qref (:,:,iblk), & - fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & - faero_ocn(:,:,:,iblk), & - alvdr (:,:,iblk), alidr (:,:,iblk), & - alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk)) - -#ifdef CICE_IN_NEMO -!echmod - comment this out for efficiency, if .not. calc_Tsfc - if (.not. calc_Tsfc) then - - !--------------------------------------------------------------- - ! If surface fluxes were provided, conserve these fluxes at ice - ! free points by passing to ocean. - !--------------------------------------------------------------- - - call sfcflux_to_ocn & - (nx_block, ny_block, & - tmask (:,:,iblk), aice_init(:,:,iblk), & - fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & - fresh (:,:,iblk), fhocn (:,:,iblk)) - endif -!echmod -#endif - call ice_timer_stop(timer_couple) ! atm/ocn coupling - - end subroutine coupling_prep - -#ifdef CICE_IN_NEMO - -!======================================================================= -! -! If surface heat fluxes are provided to CICE instead of CICE calculating -! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can -! be provided at points which do not have ice. (This is could be due to -! the heat fluxes being calculated on a lower resolution grid or the -! heat fluxes not recalculated at every CICE timestep.) At ice free points, -! conserve energy and water by passing these fluxes to the ocean. -! -! author: A. McLaren, Met Office - - subroutine sfcflux_to_ocn(nx_block, ny_block, & - tmask, aice, & - fsurfn_f, flatn_f, & - fresh, fhocn) - - use ice_domain_size, only: ncat - - integer (kind=int_kind), intent(in) :: & - nx_block, ny_block ! block dimensions - - logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & - tmask ! land/boundary mask, thickness (T-cell) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & - aice ! initial ice concentration - - real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & - fsurfn_f, & ! net surface heat flux (provided as forcing) - flatn_f ! latent heat flux (provided as forcing) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & - fresh , & ! fresh water flux to ocean (kg/m2/s) - fhocn ! actual ocn/ice heat flx (W/m**2) - - - ! local variables - integer (kind=int_kind) :: & - i, j, n ! horizontal indices - - real (kind=dbl_kind) :: & - puny, & ! - rLsub ! 1/Lsub - - character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - - 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__) - rLsub = c1 / Lsub - - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j) .and. aice(i,j) <= puny) then - fhocn(i,j) = fhocn(i,j) & - + fsurfn_f(i,j,n) + flatn_f(i,j,n) - fresh(i,j) = fresh(i,j) & - + flatn_f(i,j,n) * rLsub - endif - enddo ! i - enddo ! j - enddo ! n - - - end subroutine sfcflux_to_ocn - -#endif - -!======================================================================= - - end module CICE_RunMod - -!======================================================================= diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 0b61433a3..59bbca31c 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -77,7 +77,7 @@ subroutine cice_init use ice_forcing, only: init_forcing_ocn, init_forcing_atmo, & get_forcing_atmo, get_forcing_ocn, get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default, faero_optics, alloc_forcing_bgc + faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_grid, only: init_grid1, init_grid2, alloc_grid use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype @@ -92,7 +92,7 @@ subroutine cice_init #endif logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & - tr_fsd, wave_spec + tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' call init_communicate ! initial setup for message passing @@ -122,7 +122,6 @@ subroutine cice_init call ice_timer_start(timer_total) ! start timing entire run call init_grid2 ! grid variables call init_zbgc ! vertical biogeochemistry initialization - call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file @@ -134,6 +133,7 @@ subroutine cice_init endif call init_coupler_flux ! initialize fluxes exchanged with coupler + #ifdef popcice call sst_sss ! POP data for CICE initialization #endif @@ -181,6 +181,7 @@ subroutine cice_init call init_history_dyn ! initialize dynamic history variables 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_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) @@ -211,6 +212,8 @@ subroutine cice_init call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -239,20 +242,21 @@ subroutine init_restart use ice_calendar, only: time, calendar use ice_constants, only: c0 use ice_domain, only: nblocks - use ice_domain_size, only: ncat, n_aero, nfsd + use ice_domain_size, only: ncat, n_iso, n_aero, nfsd use ice_dyn_eap, only: read_restart_eap use ice_dyn_shared, only: kdyn use ice_grid, only: tmask use ice_init, only: ice_ic use ice_init_column, only: init_age, init_FY, init_lvl, & init_meltponds_cesm, init_meltponds_lvl, init_meltponds_topo, & - init_aerosol, init_hbrine, init_bgc, init_fsd + init_isotope, init_aerosol, init_hbrine, init_bgc, init_fsd use ice_restart_column, only: restart_age, read_restart_age, & restart_FY, read_restart_FY, restart_lvl, read_restart_lvl, & restart_pond_cesm, read_restart_pond_cesm, & restart_pond_lvl, read_restart_pond_lvl, & restart_pond_topo, read_restart_pond_topo, & restart_fsd, read_restart_fsd, & + restart_iso, read_restart_iso, & restart_aero, read_restart_aero, & restart_hbrine, read_restart_hbrine, & restart_zsal, restart_bgc @@ -265,13 +269,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_aero, tr_brine, & + tr_pond_topo, 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_iage, nt_FY, nt_aero, nt_fsd + nt_iage, nt_FY, nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname = '(init_restart)' @@ -285,10 +289,11 @@ 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_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_iage_out=nt_iage, nt_FY_out=nt_FY, nt_aero_out=nt_aero, nt_fsd_out=nt_fsd, & + nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -393,6 +398,20 @@ subroutine init_restart call init_fsd(trcrn(:,:,nt_fsd:nt_fsd+nfsd-1,:,:)) endif endif + + ! isotopes + if (tr_iso) then + if (trim(runtype) == 'continue') restart_iso = .true. + if (restart_iso) then + call read_restart_iso + else + do iblk = 1, nblocks + call init_isotope(trcrn(:,:,nt_isosno:nt_isosno+n_iso-1,:,iblk), & + trcrn(:,:,nt_isoice:nt_isoice+n_iso-1,:,iblk)) + enddo ! iblk + endif + endif + if (tr_aero) then ! ice aerosol if (trim(runtype) == 'continue') restart_aero = .true. if (restart_aero) then diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index ad974475b..7645c43f3 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -21,7 +21,7 @@ module CICE_RunMod use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes @@ -47,12 +47,12 @@ subroutine CICE_Run use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default + fiso_default, faero_default use ice_flux, only: init_flux_atm, init_flux_ocn use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_couple, timer_step logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' !-------------------------------------------------------------------- @@ -64,7 +64,8 @@ subroutine CICE_Run call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & tr_zaero_out=tr_zaero, & tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -100,6 +101,8 @@ subroutine CICE_Run call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -151,7 +154,7 @@ 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_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine 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, & @@ -171,7 +174,7 @@ subroutine ice_step logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & + 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 character(len=*), parameter :: subname = '(ice_step)' @@ -182,7 +185,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_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -227,7 +230,7 @@ subroutine ice_step call biogeochemistry (dt, iblk) ! biogeochemistry call step_therm2 (dt, iblk) ! ice thickness distribution thermo - endif + endif ! ktherm > 0 enddo ! iblk !$OMP END PARALLEL DO @@ -322,6 +325,7 @@ subroutine ice_step if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & call write_restart_bgc @@ -356,7 +360,8 @@ subroutine coupling_prep (iblk) swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -535,7 +540,8 @@ subroutine coupling_prep (iblk) !----------------------------------------------------------------- call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & aice (:,:,iblk), Tf (:,:,iblk), & Tair (:,:,iblk), Qa (:,:,iblk), & strairxT (:,:,iblk), strairyT(:,:,iblk), & @@ -549,7 +555,10 @@ subroutine coupling_prep (iblk) alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk)) + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk)) #ifdef CICE_IN_NEMO !echmod - comment this out for efficiency, if .not. calc_Tsfc diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug index 5de6b1cfd..7ca555433 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug @@ -21,9 +21,9 @@ use ice_constants, only: field_loc_center, field_type_scalar use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_aero + use icepack_intfc, only: icepack_max_iso, icepack_max_aero use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_numbers + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes implicit none private @@ -47,12 +47,12 @@ use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - faero_default + fiso_default, faero_default use ice_flux, only: init_flux_atm, init_flux_ocn use ice_timers, only: ice_timer_start, ice_timer_stop, & timer_couple, timer_step logical (kind=log_kind) :: & - tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd + tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd character(len=*), parameter :: subname = '(CICE_Run)' !-------------------------------------------------------------------- @@ -64,7 +64,8 @@ call icepack_query_parameters(skl_bgc_out=skl_bgc, & z_tracers_out=z_tracers, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_aero_out=tr_aero, & + call icepack_query_tracer_flags(tr_iso_out=tr_iso, & + tr_aero_out=tr_aero, & tr_zaero_out=tr_zaero, & tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) @@ -100,6 +101,8 @@ call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data + ! isotopes + if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file ! if (tr_zaero) call fzaero_data ! data file (gx1) @@ -151,7 +154,7 @@ 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_bgc, write_restart_hbrine + write_restart_iso, write_restart_bgc, write_restart_hbrine 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, & @@ -171,7 +174,7 @@ logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_aero, & + 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 character(len=*), parameter :: subname = '(ice_step)' @@ -189,7 +192,7 @@ 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_fsd_out=tr_fsd) + tr_iso_out=tr_iso, tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -273,8 +276,10 @@ ! momentum, stress, transport call step_dyn_horiz (dt_dyn) + do iblk = 1, nblocks plabeld = 'post step_dyn_horiz' call debug_ice (iblk, plabeld) + enddo ! iblk ! ridging !$OMP PARALLEL DO PRIVATE(iblk) @@ -283,6 +288,11 @@ enddo !$OMP END PARALLEL DO + do iblk = 1, nblocks + plabeld = 'post step_dyn_ridge' + call debug_ice (iblk, plabeld) + enddo ! iblk + ! clean up, update tendency diagnostics offset = c0 call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) @@ -357,6 +367,7 @@ if (tr_pond_lvl) call write_restart_pond_lvl if (tr_pond_topo) call write_restart_pond_topo if (tr_fsd) call write_restart_fsd + if (tr_iso) call write_restart_iso if (tr_aero) call write_restart_aero if (solve_zsal .or. skl_bgc .or. z_tracers) & call write_restart_bgc @@ -391,7 +402,8 @@ swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai use ice_grid, only: tmask use ice_state, only: aicen, aice #ifdef CICE_IN_NEMO @@ -428,7 +440,7 @@ character(len=*), parameter :: subname = '(coupling_prep)' call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) - call icepack_query_tracer_numbers(nbtrcr_out=nbtrcr) + call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -570,7 +582,8 @@ !----------------------------------------------------------------- call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, icepack_max_aero, & + tmask (:,:,iblk), nbtrcr, & + icepack_max_aero, & aice (:,:,iblk), Tf (:,:,iblk), & Tair (:,:,iblk), Qa (:,:,iblk), & strairxT (:,:,iblk), strairyT(:,:,iblk), & @@ -584,7 +597,10 @@ alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio(:,:,1:nbtrcr,iblk)) + flux_bio (:,:,1:nbtrcr,iblk), & + Qref_iso =Qref_iso (:,:,:,iblk), & + fiso_evap=fiso_evap(:,:,:,iblk), & + fiso_ocn =fiso_ocn (:,:,:,iblk)) #ifdef CICE_IN_NEMO !echmod - comment this out for efficiency, if .not. calc_Tsfc diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 4af95ae1f..8c5808820 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -118,8 +118,7 @@ function create_distribution(dist_type, nprocs, work_per_block) case('spacecurve') - create_distribution = create_distrb_spacecurve(nprocs, & - work_per_block) + create_distribution = create_distrb_spacecurve(nprocs, work_per_block) case default @@ -364,7 +363,7 @@ subroutine ice_distributionDestroy(distribution) ! !---------------------------------------------------------------------- - distribution%nprocs = 0 + distribution%nprocs = 0 distribution%communicator = 0 distribution%numLocalBlocks = 0 @@ -377,6 +376,9 @@ subroutine ice_distributionDestroy(distribution) deallocate(distribution%blockLocation, stat=istat) deallocate(distribution%blockLocalID , stat=istat) deallocate(distribution%blockGlobalID, stat=istat) + deallocate(distribution%blockCnt , stat=istat) + deallocate(distribution%blockindex , stat=istat) + !----------------------------------------------------------------------- @@ -611,6 +613,12 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) return endif + allocate (newDistrb%blockCnt(nprocs)) + newDistrb%blockCnt(:) = 0 + + allocate(newDistrb%blockIndex(nprocs,max_blocks)) + newDistrb%blockIndex(:,:) = 0 + !---------------------------------------------------------------------- ! ! distribute blocks linearly across processors in each direction @@ -640,6 +648,8 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) localID = localID + 1 newDistrb%blockLocation(globalID) = processor newDistrb%blockLocalID (globalID) = localID + newDistrb%blockCnt(processor) = newDistrb%blockCnt(processor) + 1 + newDistrb%blockIndex(processor,localID) = globalID else ! no work - eliminate block from distribution newDistrb%blockLocation(globalID) = 0 newDistrb%blockLocalID (globalID) = 0 @@ -966,6 +976,12 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) return endif + allocate (newDistrb%blockCnt(nprocs)) + newDistrb%blockCnt(:) = 0 + + allocate(newDistrb%blockIndex(nprocs,max_blocks)) + newDistrb%blockIndex(:,:) = 0 + allocate(procTmp(nprocs), stat=istat) if (istat > 0) then call abort_ice( & @@ -981,11 +997,13 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) if (pid > 0) then procTmp(pid) = procTmp(pid) + 1 newDistrb%blockLocalID (n) = procTmp(pid) + newDistrb%blockIndex(pid,procTmp(pid)) = n else newDistrb%blockLocalID (n) = 0 endif end do + newDistrb%blockCnt(:) = procTmp(:) newDistrb%numLocalBlocks = procTmp(my_task+1) if (minval(procTmp) < 1) then @@ -2146,6 +2164,12 @@ function create_distrb_spacecurve(nprocs,work_per_block) dist%blockLocation=0 dist%blockLocalID =0 + allocate (dist%blockCnt(nprocs)) + dist%blockCnt(:) = 0 + + allocate(dist%blockIndex(nprocs,max_blocks)) + dist%blockIndex(:,:) = 0 + !---------------------------------------------------------------------- ! Create the array to hold the SFC and indices into it !---------------------------------------------------------------------- @@ -2281,12 +2305,14 @@ function create_distrb_spacecurve(nprocs,work_per_block) if(pid>0) then proc_tmp(pid) = proc_tmp(pid) + 1 dist%blockLocalID(n) = proc_tmp(pid) + dist%blockIndex(pid,proc_tmp(pid)) = n else dist%blockLocalID(n) = 0 endif enddo dist%numLocalBlocks = proc_tmp(my_task+1) + dist%blockCnt(:) = proc_tmp(:) if (dist%numLocalBlocks > 0) then allocate (dist%blockGlobalID(dist%numLocalBlocks)) diff --git a/cicecore/shared/ice_domain_size.F90 b/cicecore/shared/ice_domain_size.F90 index 6f7a73aa1..56381b986 100644 --- a/cicecore/shared/ice_domain_size.F90 +++ b/cicecore/shared/ice_domain_size.F90 @@ -32,10 +32,11 @@ module ice_domain_size nfsd , & ! number of floe size categories nilyr , & ! number of ice layers per category nslyr , & ! number of snow layers per category - nblyr , & ! number of bio/brine layers per category + nblyr , & ! number of bio/brine layers per category + n_iso , & ! number of isotopes in use n_aero , & ! number of aerosols in use - n_zaero , & ! number of z aerosols in use - n_algae , & ! number of algae in use + n_zaero , & ! number of z aerosols in use + n_algae , & ! number of algae in use n_doc , & ! number of DOC pools in use n_dic , & ! number of DIC pools in use n_don , & ! number of DON pools in use diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index 00f7acaef..4c91fdb2a 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -54,6 +54,8 @@ module ice_fileunits nu_restart_pond,& ! restart input file for melt pond tracer 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 + nu_restart_iso, & ! restart input file for isotope tracers nu_dump_aero , & ! dump file for restarting aerosol tracer nu_restart_aero,& ! restart input file for aerosol tracer nu_dump_bgc , & ! dump file for restarting bgc @@ -106,7 +108,7 @@ subroutine init_fileunits character(len=*),parameter :: subname='(init_fileunits)' - allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit)) + if (.not.allocated(ice_IOUnitsInUse)) allocate(ice_IOUnitsInUse(ice_IOUnitsMaxUnit)) ice_IOUnitsInUse = .false. ice_IOUnitsInUse(ice_stdin) = .true. ! reserve unit 5 @@ -130,6 +132,8 @@ subroutine init_fileunits call get_fileunit(nu_restart_pond) call get_fileunit(nu_dump_fsd) call get_fileunit(nu_restart_fsd) + call get_fileunit(nu_dump_iso) + call get_fileunit(nu_restart_iso) call get_fileunit(nu_dump_aero) call get_fileunit(nu_restart_aero) call get_fileunit(nu_dump_bgc) @@ -217,6 +221,8 @@ subroutine release_all_fileunits call release_fileunit(nu_restart_pond) call release_fileunit(nu_dump_fsd) call release_fileunit(nu_restart_fsd) + call release_fileunit(nu_dump_iso) + call release_fileunit(nu_restart_iso) call release_fileunit(nu_dump_aero) call release_fileunit(nu_restart_aero) call release_fileunit(nu_dump_bgc) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 19deb0159..fbcc8413b 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -45,7 +45,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 + count_tracers, init_isotope ! namelist parameters needed locally @@ -671,6 +671,21 @@ end subroutine init_fsd !======================================================================= +! Initialize isotope tracers (call prior to reading restart data) + + subroutine init_isotope(isosno, isoice) + + real(kind=dbl_kind), dimension(:,:,:,:), intent(out) :: & + isosno, isoice + character(len=*),parameter :: subname='(init_isotope)' + + isosno(:,:,:,:) = c0 + isoice(:,:,:,:) = c0 + + end subroutine init_isotope + +!======================================================================= + ! Initialize ice aerosol tracer (call prior to reading restart data) subroutine init_aerosol(aero) @@ -1731,7 +1746,7 @@ end subroutine input_zbgc subroutine count_tracers - use ice_domain_size, only: nilyr, nslyr, nblyr, nfsd, & + use ice_domain_size, only: nilyr, nslyr, nblyr, nfsd, n_iso, & n_aero, n_zaero, n_algae, n_doc, n_dic, n_don, n_fed, n_fep ! local variables @@ -1743,10 +1758,10 @@ 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_pond_cesm, tr_pond_lvl, tr_pond_topo + 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 + integer (kind=int_kind) :: nt_fsd, nt_isosno, nt_isoice integer (kind=int_kind) :: & nbtrcr, nbtrcr_sw, & @@ -1829,6 +1844,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_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, & @@ -1897,13 +1913,22 @@ subroutine count_tracers ntrcr = ntrcr + nfsd endif + nt_isosno = 0 + nt_isoice = 0 + if (tr_iso) then + nt_isosno = ntrcr + 1 ! isotopes in snow + ntrcr = ntrcr + n_iso + nt_isoice = ntrcr + 1 ! isotopes in ice + ntrcr = ntrcr + n_iso + endif + nt_aero = 0 if (tr_aero) then nt_aero = ntrcr + 1 ntrcr = ntrcr + 4*n_aero ! 4 dEdd layers, n_aero species else !tcx, modify code so we don't have to reset n_aero here - n_aero = 0 + n_aero = 0 !echmod - this is not getting set correctly (overwritten later?) endif !----------------------------------------------------------------- @@ -2178,6 +2203,8 @@ subroutine count_tracers if (nt_hpnd <= 0) nt_hpnd = ntrcr if (nt_ipnd <= 0) nt_ipnd = ntrcr if (nt_fsd <= 0) nt_fsd = ntrcr + if (nt_isosno<= 0) nt_isosno= ntrcr + if (nt_isoice<= 0) nt_isoice= ntrcr if (nt_aero <= 0) nt_aero = ntrcr if (nt_fbri <= 0) nt_fbri = ntrcr if (nt_bgc_S <= 0) nt_bgc_S = ntrcr @@ -2201,7 +2228,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_fbri_in=nt_fbri, & + nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice, nt_fbri_in=nt_fbri, & nt_bgc_Nit_in=nt_bgc_Nit, nt_bgc_Am_in=nt_bgc_Am, nt_bgc_Sil_in=nt_bgc_Sil, & nt_bgc_DMS_in=nt_bgc_DMS, nt_bgc_PON_in=nt_bgc_PON, nt_bgc_S_in=nt_bgc_S, & nt_bgc_N_in=nt_bgc_N, nt_bgc_chl_in=nt_bgc_chl, & diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index 34055a751..e830dd50b 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -33,6 +33,7 @@ module ice_restart_column write_restart_pond_lvl, read_restart_pond_lvl, & write_restart_pond_topo, read_restart_pond_topo, & write_restart_fsd, read_restart_fsd, & + write_restart_iso, read_restart_iso, & write_restart_aero, read_restart_aero, & write_restart_bgc, read_restart_bgc, & write_restart_hbrine, read_restart_hbrine @@ -45,6 +46,7 @@ module ice_restart_column restart_pond_lvl , & ! if .true., read meltponds restart file restart_pond_topo, & ! if .true., read meltponds 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 restart_zsal , & ! if .true., read Salinity from restart file restart_hbrine , & ! if .true., read hbrine from restart file @@ -551,6 +553,89 @@ end subroutine read_restart_fsd !======================================================================= +! Dumps all values needed for restarting +! author Elizabeth C. Hunke, LANL + + subroutine write_restart_iso() + + use ice_domain_size, only: n_iso + use ice_fileunits, only: nu_dump_iso + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: diag + integer (kind=int_kind) :: nt_isosno, nt_isoice, k + character*3 ck + character(len=*),parameter :: subname='(write_restart_iso)' + + call icepack_query_tracer_indices(nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + diag = .true. + + !----------------------------------------------------------------- + + do k = 1, n_iso + write(ck,'(i3.3)') k + call write_restart_field(nu_dump_iso,0, trcrn(:,:,nt_isosno+k-1,:,:), & + 'ruf8','isosno'//trim(ck),ncat,diag) + enddo + + do k = 1, n_iso + write(ck,'(i3.3)') k + call write_restart_field(nu_dump_iso,0, trcrn(:,:,nt_isoice+k-1,:,:), & + 'ruf8','isoice'//trim(ck),ncat,diag) + enddo + + end subroutine write_restart_iso + +!======================================================================= + +! Reads all values needed to restart isotope tracers +! author Elizabeth C. Hunke, LANL + + subroutine read_restart_iso() + + use ice_domain_size, only: n_iso + use ice_fileunits, only: nu_restart_iso + use ice_state, only: trcrn + + ! local variables + + logical (kind=log_kind) :: & + diag + integer (kind=int_kind) :: nt_isosno, nt_isoice, k + character*3 ck + character(len=*),parameter :: subname='(read_restart_iso)' + + call icepack_query_tracer_indices(nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + diag = .true. + + do k = 1, n_iso + write(ck,'(i3.3)') k + call read_restart_field(nu_restart_iso,0,trcrn(:,:,nt_isosno+k-1,:,:), & + 'ruf8','isosno'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + enddo + + do k = 1, n_iso + write(ck,'(i3.3)') k + call read_restart_field(nu_restart_iso,0,trcrn(:,:,nt_isoice+k-1,:,:), & + 'ruf8','isoice'//trim(ck),ncat,diag, & + field_type=field_type_scalar,field_loc=field_loc_center) + enddo + + end subroutine read_restart_iso + +!======================================================================= + ! Dumps all values needed for restarting ! ! authors Elizabeth Hunke, LANL (original version) diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 000000000..e7f6a6e2f --- /dev/null +++ b/codecov.yml @@ -0,0 +1,6 @@ +coverage: + range: "20...100" + round: down + precision: 2 + +comment: false diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 0450d2647..e8ec14cab 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -119,7 +119,7 @@ else if (${ICE_MACHINE} =~ cori*) then @ nthrds2 = ${nthrds} * 2 cat >> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} -###SBATCH -A ${acct} +#SBATCH -A ${acct} #SBATCH --qos ${queue} #SBATCH --time ${batchtime} #SBATCH --nodes ${nnodes} diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index 61d639e09..2534bfa7e 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -1,7 +1,7 @@ #! /bin/csh -f #==================================== -# If the cice binary is passed as an argument and the file exists, +# If the cice binary is passed via the --exe argument and the file exists, # copy it into the run directory and don't build the model. set dohelp = 0 diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index 8bb860916..7d9bce65c 100755 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -40,4 +40,5 @@ if (${ICE_NTASKS} == 1) setenv ICE_COMMDIR serial ### Specialty code setenv ICE_BLDDEBUG false # build debug flags +setenv ICE_CODECOV false # build debug flags diff --git a/configuration/scripts/cice.test.setup.csh b/configuration/scripts/cice.test.setup.csh index 16fd84a69..535a2ac06 100755 --- a/configuration/scripts/cice.test.setup.csh +++ b/configuration/scripts/cice.test.setup.csh @@ -40,6 +40,13 @@ if ( ! -f ${ICE_RUNDIR}/cice ) then exit 99 endif +# Initial test results and Reset test results for rerun +mv -f ${ICE_CASEDIR}/test_output ${ICE_CASEDIR}/test_output.prev +echo "#---" >! ${ICE_CASEDIR}/test_output +cat ${ICE_CASEDIR}/test_output.prev | grep -i "${ICE_TESTNAME} build" >> ${ICE_CASEDIR}/test_output +echo "PEND ${ICE_TESTNAME} run" >> ${ICE_CASEDIR}/test_output +rm -f ${ICE_CASEDIR}/test_output.prev + EOF2 if ( -f ${ICE_SCRIPTS}/tests/test_${ICE_TEST}.script) then diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 406e8ec91..dcfedf772 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -63,6 +63,7 @@ / &tracer_nml + n_iso = 0 n_aero = 1 n_zaero = 0 n_algae = 0 @@ -83,6 +84,8 @@ restart_pond_topo = .false. tr_pond_lvl = .true. restart_pond_lvl = .false. + tr_iso = .false. + restart_iso = .false. tr_aero = .false. restart_aero = .false. tr_fsd = .false. @@ -93,6 +96,7 @@ kitd = 1 ktherm = 2 conduct = 'bubbly' + ksno = 0.3d0 a_rapid_mode = 0.5e-3 Rac_rapid_mode = 10.0 aspect_rapid_mode = 1.0 @@ -529,9 +533,12 @@ / &icefields_bgc_nml + f_fiso_atm = 'x' + f_fiso_ocn = 'x' + f_iso = 'x' f_faero_atm = 'x' f_faero_ocn = 'x' - f_aero = 'x' + f_aero = 'x' f_fbio = 'm' f_fbio_ai = 'm' f_zaero = 'x' diff --git a/configuration/scripts/machines/Macros.gaffney_gnu b/configuration/scripts/machines/Macros.gaffney_gnu index b2f178247..0d13560de 100644 --- a/configuration/scripts/machines/Macros.gaffney_gnu +++ b/configuration/scripts/machines/Macros.gaffney_gnu @@ -4,7 +4,7 @@ CPP := ftn -E CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 +CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form @@ -12,9 +12,21 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow -else - FFLAGS += -O2 + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_CODECOV), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_CODECOV), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif endif SCC := gcc diff --git a/configuration/scripts/machines/Macros.gordon_gnu b/configuration/scripts/machines/Macros.gordon_gnu index 131f539c1..2e80f7364 100644 --- a/configuration/scripts/machines/Macros.gordon_gnu +++ b/configuration/scripts/machines/Macros.gordon_gnu @@ -4,7 +4,7 @@ CPP := ftn -E CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 +CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form @@ -12,9 +12,21 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow -else - FFLAGS += -O2 + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_CODECOV), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_CODECOV), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif endif SCC := cc diff --git a/configuration/scripts/machines/Macros.izumi_gnu b/configuration/scripts/machines/Macros.izumi_gnu index 6526ac767..cdc6620f4 100644 --- a/configuration/scripts/machines/Macros.izumi_gnu +++ b/configuration/scripts/machines/Macros.izumi_gnu @@ -4,7 +4,7 @@ CPP := /usr/bin/cpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 +CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form @@ -13,8 +13,20 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow -else + CFLAGS += -O0 +endif + +ifeq ($(ICE_CODECOV), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_CODECOV), true) FFLAGS += -O2 + CFLAGS += -O2 +endif endif SCC := gcc diff --git a/configuration/scripts/machines/Macros.onyx_gnu b/configuration/scripts/machines/Macros.onyx_gnu index 14784e625..d423cd9ab 100644 --- a/configuration/scripts/machines/Macros.onyx_gnu +++ b/configuration/scripts/machines/Macros.onyx_gnu @@ -4,7 +4,7 @@ CPP := ftn -E CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 +CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form @@ -12,9 +12,21 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow -else - FFLAGS += -O2 + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_CODECOV), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_CODECOV), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif endif SCC := cc diff --git a/configuration/scripts/machines/Macros.travisCI_gnu b/configuration/scripts/machines/Macros.travisCI_gnu index 66fb30a07..aa7b12c05 100644 --- a/configuration/scripts/machines/Macros.travisCI_gnu +++ b/configuration/scripts/machines/Macros.travisCI_gnu @@ -4,7 +4,7 @@ CPP := cpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 +CFLAGS := -c FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form @@ -12,9 +12,21 @@ FFLAGS := -fconvert=big-endian -fbacktrace -ffree-line-length-none FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow -else - FFLAGS += -O2 + FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow + CFLAGS += -O0 +endif + +ifeq ($(ICE_CODECOV), true) + FFLAGS += -O0 -g -fprofile-arcs -ftest-coverage + CFLAGS += -O0 -g -coverage + LDFLAGS += -g -ftest-coverage -fprofile-arcs +endif + +ifneq ($(ICE_BLDDEBUG), true) +ifneq ($(ICE_CODECOV), true) + FFLAGS += -O2 + CFLAGS += -O2 +endif endif SCC := gcc diff --git a/configuration/scripts/machines/env.badger_intel b/configuration/scripts/machines/env.badger_intel index 3e7bb4f8c..8fe69148b 100755 --- a/configuration/scripts/machines/env.badger_intel +++ b/configuration/scripts/machines/env.badger_intel @@ -37,7 +37,8 @@ setenv ICE_MACHINE_WKDIR /net/scratch3/$user/CICE_RUNS setenv ICE_MACHINE_INPUTDATA /usr/projects/climate/eclare/DATA/Consortium setenv ICE_MACHINE_BASELINE /net/scratch3/$user/CICE_BASELINE setenv ICE_MACHINE_SUBMIT "sbatch " -setenv ICE_MACHINE_ACCT e3sm +#setenv ICE_MACHINE_ACCT e3sm +setenv ICE_MACHINE_ACCT climatehilat setenv ICE_MACHINE_QUEUE "default" setenv ICE_MACHINE_TPNODE 16 setenv ICE_MACHINE_BLDTHRDS 1 diff --git a/configuration/scripts/options/set_nml.isotope b/configuration/scripts/options/set_nml.isotope new file mode 100644 index 000000000..b3042ee5f --- /dev/null +++ b/configuration/scripts/options/set_nml.isotope @@ -0,0 +1,2 @@ +n_iso = 3 +tr_iso = .true. diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 4b0d35e5a..fad8b22f3 100755 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -45,3 +45,6 @@ smoke gx3 4x2 fsd1,diag24,run5day,debug smoke gx3 8x2 fsd12,diag24,run5day,short restart gx3 4x2 fsd12,debug,short smoke gx3 8x2 fsd12ww3,diag24,run1day,medium +smoke gx3 4x1 isotope,debug +restart gx3 8x2 isotope + diff --git a/configuration/scripts/tests/nothread_suite.ts b/configuration/scripts/tests/nothread_suite.ts index 5db402d34..49f834a98 100644 --- a/configuration/scripts/tests/nothread_suite.ts +++ b/configuration/scripts/tests/nothread_suite.ts @@ -26,6 +26,12 @@ restart gx3 20x1 alt02,debug,short restart gx3 24x1 alt03,debug,short smoke gx3 24x1 alt04,debug,short smoke gx3 32x1 alt05,debug,short +restart gx3 16x1 isotope +smoke gx3 6x1 isotope,debug +smoke gx3 8x1 fsd1,diag24,run5day,debug +smoke gx3 16x1 fsd12,diag24,run5day,short +restart gx3 12x1 fsd12,debug,short +smoke gx3 20x1 fsd12ww3,diag24,run1day,medium restart gbox128 8x1 short restart gbox128 16x1 boxdyn,short @@ -37,6 +43,12 @@ smoke gbox128 24x1 boxrestore,short,debug restart gbox80 1x1 box2001 smoke gbox80 1x1 boxslotcyl +smoke gx3 16x1 jra55_gx3_2008,medium,run90day +restart gx3 12x1 jra55_gx3,short +#tcraig, hangs nodes intermittently on izumi +#smoke gx1 24x1 jra55_gx1_2008,medium,run90day +#restart gx1 24x1 jra55_gx1,short + smoke gx3 16x1 bgcz smoke gx3 16x1 bgcz,debug smoke gx3 24x1 bgcskl,debug diff --git a/configuration/scripts/tests/report_results.csh b/configuration/scripts/tests/report_results.csh index 711dc3e3d..4a64deff8 100755 --- a/configuration/scripts/tests/report_results.csh +++ b/configuration/scripts/tests/report_results.csh @@ -1,5 +1,19 @@ #!/bin/csh -f +if ($#argv == 0) then + echo "${0}: Running results.csh" + ./results.csh >& /dev/null +else if ($#argv == 1) then + if ("$argv[1]" =~ "-n") then + #continue + else + echo "$0 usage:" + echo "$0 [-n]" + echo " -n : do NOT run results.csh (by default it does)" + exit -1 + endif +endif + if (! -e results.log) then echo " " echo "${0}: ERROR results.log does not exist, try running results.csh" @@ -25,6 +39,7 @@ set hash = `grep "#hash = " results.log | cut -c 9-` set shhash = `grep "#hshs = " results.log | cut -c 9-` set hashuser = `grep "#hshu = " results.log | cut -c 9-` set hashdate = `grep "#hshd = " results.log | cut -c 9-` +set testsuites = `grep "#suit = " results.log | cut -c 9-` set cdat = `grep "#date = " results.log | cut -c 9-` set ctim = `grep "#time = " results.log | cut -c 9-` set user = `grep "#user = " results.log | cut -c 9-` @@ -42,6 +57,7 @@ set compilers = `grep -v "#" results.log | grep ${mach}_ | cut -d "_" -f 2 | sor #echo "debug ${shhash}" #echo "debug ${hashuser}" #echo "debug ${hashdate}" +#echo "debug ${testsuites}" #echo "debug ${cdat}" #echo "debug ${ctim}" #echo "debug ${user}" @@ -79,12 +95,21 @@ unset noglob foreach compiler ( ${compilers} ) - set ofile = "${shhash}.${mach}.${compiler}.${xcdat}.${xctim}" - set outfile = "${wikiname}/${tsubdir}/${ofile}.md" + set cnt = 0 + set found = 1 + while ($found == 1) + set ofile = "${shhash}.${mach}.${compiler}.${xcdat}.${xctim}.$cnt" + set outfile = "${wikiname}/${tsubdir}/${ofile}.md" + if (-e ${outfile}) then + @ cnt = $cnt + 1 + else + set found = 0 + endif + end + mkdir -p ${wikiname}/${tsubdir} echo "${0}: writing to ${outfile}" - if (-e ${outfile}) rm -f ${outfile} cat >! ${outfile} << EOF @@ -103,7 +128,7 @@ EOF foreach case ( ${cases} ) if ( ${case} =~ *_${compiler}_* ) then -# check thata case results are meaningful +# check that case results are meaningful set fbuild = `grep " ${case} " results.log | grep " build" | cut -c 1-4` set frun = `grep " ${case} " results.log | grep " run" | cut -c 1-4` set ftest = `grep " ${case} " results.log | grep " test" | cut -c 1-4` diff --git a/configuration/scripts/tests/test_logbfb.script b/configuration/scripts/tests/test_logbfb.script index fbce5d918..d8e594e81 100644 --- a/configuration/scripts/tests/test_logbfb.script +++ b/configuration/scripts/tests/test_logbfb.script @@ -4,11 +4,6 @@ # This is identical to a smoke test, but triggers bfbcompare with log files instead of restarts # cice.run returns -1 if run did not complete successfully -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 -rm -f ${ICE_CASEDIR}/test_output.prev -echo "RUN ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output - ./cice.run set res="$status" diff --git a/configuration/scripts/tests/test_restart.script b/configuration/scripts/tests/test_restart.script index 20953b1e1..59729b361 100644 --- a/configuration/scripts/tests/test_restart.script +++ b/configuration/scripts/tests/test_restart.script @@ -7,14 +7,6 @@ cp ice_in ice_in.0 ${ICE_CASEDIR}/casescripts/parse_namelist.sh ice_in ${ICE_CASEDIR}/casescripts/test_nml.restart1 cp ice_in ice_in.1 -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 -echo "RUN ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output -echo "PEND ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output - ./cice.run set res="$status" @@ -27,8 +19,6 @@ if ( $res != 0 ) then echo "FAIL ${ICE_TESTNAME} run" >> ${ICE_CASEDIR}/test_output echo "FAIL ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output exit 99 -else - echo "PASS ${ICE_TESTNAME} initialrun" >> ${ICE_CASEDIR}/test_output endif # Prepend 'base_' to the final restart file to save for comparison diff --git a/configuration/scripts/tests/test_smoke.script b/configuration/scripts/tests/test_smoke.script index 42a963b47..f39f7cb4a 100644 --- a/configuration/scripts/tests/test_smoke.script +++ b/configuration/scripts/tests/test_smoke.script @@ -3,11 +3,6 @@ # Run the CICE model # cice.run returns -1 if run did not complete successfully -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 -rm -f ${ICE_CASEDIR}/test_output.prev -echo "RUN ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output - ./cice.run set res="$status" diff --git a/doc/source/developer_guide/dg_other.rst b/doc/source/developer_guide/dg_other.rst index 2a46186bd..7853cb66b 100644 --- a/doc/source/developer_guide/dg_other.rst +++ b/doc/source/developer_guide/dg_other.rst @@ -132,8 +132,8 @@ tracer. A number of optional tracers are available in the code, including ice age, first-year ice area, melt pond area and volume, brine height, -aerosols, and level ice area and volume (from which ridged ice -quantities are derived). Salinity, enthalpies, age, aerosols, level-ice +aerosols, water isotopes, and level ice area and volume (from which ridged ice +quantities are derived). Salinity, enthalpies, age, aerosols, isotopes, level-ice volume, brine height and most melt pond quantities are volume-weighted tracers, while first-year area, pond area, and level-ice area are area-weighted tracers. Biogeochemistry tracers in the skeletal layer are area-weighted, diff --git a/doc/source/science_guide/sg_tracers.rst b/doc/source/science_guide/sg_tracers.rst index bc55a47f9..bbd18eb1f 100644 --- a/doc/source/science_guide/sg_tracers.rst +++ b/doc/source/science_guide/sg_tracers.rst @@ -87,6 +87,7 @@ is not in use. " ", " ", "apnd", "nt_vpnd", " " " ", " ", "apnd", "nt_ipnd", " " "tr_aero", "n_aero", "vice, vsno", "nt_aero"," " + "tr_iso", "n_iso", "vice, vsno", "nt_iso"," " "tr_brine", " ", "vice", "nt_fbri", " " "tr_fsd","nfsd","aice","nt_fsd"," " "solve_zsal", "n_trzs", "fbri or (a,v)ice", "nt_bgc_S", " " @@ -114,5 +115,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, -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, 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 411b22fb8..b3088963d 100755 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -206,6 +206,7 @@ Table of namelist options "","*tracer_nml*", "", "", "" "","", "", "**Tracers**", "" "","``n_aero``", "integer", "number of aerosol tracers", "1" + "","``n_iso``", "integer", "number of isotope tracers", "1" "","``n_zaero``", "0,1,2,3,4,5,6", "number of z aerosol tracers in use", "0" "","``n_algae``", "0,1,2,3", "number of algal tracers", "0" "","``n_doc``", "0,1,2,3", "number of dissolved organic carbon", "0" @@ -227,6 +228,8 @@ Table of namelist options "","``restart_pond_lvl``", "true/false", "restart tracer values from file", "" "\*","``tr_aero``", "true/false", "aerosols", "" "","``restart_aero``", "true/false", "restart tracer values from file", "" + "\*","``tr_iso``", "true/false", "isotopes", "" + "","``restart_iso``", "true/false", "restart tracer values from file", "" "\*","``tr_fsd``", "true/false", "floe size distribution", "" "","``restart_fsd``", "true/false", "restart floe size distribution values from file", "" "","", "", "", "" @@ -240,6 +243,7 @@ Table of namelist options "","", "``-1``", "thermodynamics disabled", "" "\*","``conduct``", "``Maykut71``", "conductivity :cite:`Maykut71`", "" "","", "``bubbly``", "conductivity :cite:`Pringle07`", "" + "\*","``ksno``", "real", "snow thermal conductivity", "0.3" "\*","``a_rapid_mode``", "real", "brine channel diameter", "0.5x10 :math:`^{-3}` m" "\*","``Rac_rapid_mode``", "real", "critical Rayleigh number", "10" "\*","``aspect_rapid_mode``", "real", "brine convection aspect ratio", "1" diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 48679577c..52621d612 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -380,6 +380,9 @@ following options are valid for suites, ``--report`` This is only used by ``--suite`` and when set, invokes a script that sends the test results to the results page when all tests are complete. Please see :ref:`testreporting` for more information. +``--codecov`` + When invoked, code coverage diagnostics are generated. This will modify the build and reduce optimization. The results will be uploaded to the **codecov.io** website via the **report_codecov.csh** script. General use is not recommended, this is mainly used as a diagnostic to periodically assess test coverage. Please see :ref:`codecoverage` for more information. + ``--setup-only`` This is only used by ``--suite`` and when set, just creates the suite testcases. It does not build or submit them to run. By default, the suites do ``--setup-build-submit``. @@ -645,7 +648,11 @@ To post results, once a test suite is complete, run ``results.csh`` and ./results.csh ./report_results.csh -The reporting can also be automated by adding ``--report`` to ``cice.setup`` +``report_results.csh`` will run ``results.csh`` by default automatically, but +we recommmend running it manually first to verify results before publishing +them. ``report_results.csh -n`` will turn off automatic running of ``results.csh``. + +The reporting can also be automated in a test suite by adding ``--report`` to ``cice.setup`` :: ./cice.setup --suite base_suite --mach conrad --env cray --testid v01a --report @@ -653,6 +660,55 @@ The reporting can also be automated by adding ``--report`` to ``cice.setup`` With ``--report``, the suite will create all the tests, build and submit them, wait for all runs to be complete, and run the results and report_results scripts. +.. _codecoverage: + +Code Coverage Testing +------------------------------ + +The ``--codecov`` feature in **cice.setup** provides a method to diagnose code coverage. +This argument turns on special compiler flags including reduced optimization and then +invokes the gcov tool. +This option is currently only available with the gnu compiler and on a few systems. + +Because codecov.io does not support git submodule analysis right now, a customized +repository has to be created to test CICE with Icepack integrated directly. The repository +https://github.com/apcraig/Test_CICE_Icepack serves as the current default test repository. +In general, to setup the code coverage test in CICE, the current CICE master has +to be copied into the Test_CICE_Icepack repository, then the code coverage tool can +be run on that repository. A sample script to do that would be:: + + git clone https://github.com/cice-consortium/cice cice.master --recursive + + git clone https://github.com/apcraig/test_cice_icepack + cd test_cice_icepack + git rm -r * + cp -p -r ../cice.master/* . + git add . + git commit -m "update to current cice master" + git push origin master + + ./cice.setup --suite first_suite,base_suite,travis_suite,decomp_suite,reprosum_suite,quick_suite -m gordon -e gnu --codecov --testid cc01 + +To use, submit a full test suite using an updated Test_CICE_Icepack version +and the gnu compiler with the ``--codecov`` argument. +The test suite will run and then a report will be generated and uploaded to +the `codecov.io site `_ by the +**report_codecov.csh** script. + +This is a special diagnostic test and does not constitute proper model testing. +General use is not recommended, this is mainly used as a diagnostic to periodically +assess test coverage. The interaction with codecov.io is not always robust and +can be tricky to manage. Some constraints are that the output generated at runtime +is copied into the directory where compilation took place. That means each +test should be compiled separately. Tests that invoke multiple runs +(such as exact restart and the decomp test) will only save coverage information +for the last run, so some coverage information may be lost. The gcov tool can +be a little slow to run on large test suites, and the codecov.io bash uploader +(that runs gcov and uploads the data to codecov.io) is constantly evolving. +Finally, gcov requires that the diagnostic output be copied into the git sandbox for +analysis. These constraints are handled by the current scripts, but may change +in the future. + .. _compliance: diff --git a/icepack b/icepack index edb8c3459..1ae044604 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit edb8c3459359f22af20d39d7defe97c4a8b2a419 +Subproject commit 1ae044604498b8d268df6c577556d22d2baa7758 From 183218aa6c54efafa20829624f6c7d1d34530b3c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 23 Apr 2020 17:43:35 -0600 Subject: [PATCH 02/44] updated orbital calculations needed for cesm --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 222 +++++++++++++++--- 1 file changed, 191 insertions(+), 31 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 29cd34320..49218ffe3 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,11 +15,11 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort, shr_sys_flush use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit use shr_string_mod , only : shr_string_listGetNum - use shr_orb_mod , only : shr_orb_decl + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use ice_constants , only : ice_init_constants @@ -71,6 +71,7 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize + private :: ice_orbital_init ! only for cesm character(len=CL) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 @@ -78,6 +79,17 @@ module ice_comp_nuopc integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_nextsw_cday = 0 + character(len=CL) :: orb_mode ! attribute - orbital mode + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(R8) :: orb_obliq ! attribute - obliquity in degrees + real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' + character(len=*) , parameter :: orb_variable_year = 'variable_year' + character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + integer , parameter :: dbug = 10 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level @@ -346,31 +358,32 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ice_init_constants(omega_in=SHR_CONST_OMEGA, radius_in=SHR_CONST_REARTH, & spval_dbl_in=SHR_CONST_SPVAL) + call icepack_init_parameters( & - secday_in = SHR_CONST_CDAY, & - rhoi_in = SHR_CONST_RHOICE, & - rhow_in = SHR_CONST_RHOSW, & - cp_air_in = SHR_CONST_CPDAIR, & - cp_ice_in = SHR_CONST_CPICE, & - cp_ocn_in = SHR_CONST_CPSW, & - gravit_in = SHR_CONST_G, & - rhofresh_in = SHR_CONST_RHOFW, & - zvir_in = SHR_CONST_ZVIR, & - vonkar_in = SHR_CONST_KARMAN, & - cp_wv_in = SHR_CONST_CPWV, & - stefan_boltzmann_in = SHR_CONST_STEBOL, & - Tffresh_in= SHR_CONST_TKFRZ, & - Lsub_in = SHR_CONST_LATSUB, & - Lvap_in = SHR_CONST_LATVAP, & -! Lfresh_in = SHR_CONST_LATICE, & ! computed in init_parameters as Lsub-Lvap - Timelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & - Tsmelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & - ice_ref_salinity_in = SHR_CONST_ICE_REF_SAL, & - depressT_in = 0.054_dbl_kind, & - Tocnfrz_in= -34.0_dbl_kind*0.054_dbl_kind, & - pi_in = SHR_CONST_PI, & - snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00962_dbl_kind) + secday_in = SHR_CONST_CDAY, & + rhoi_in = SHR_CONST_RHOICE, & + rhow_in = SHR_CONST_RHOSW, & + cp_air_in = SHR_CONST_CPDAIR, & + cp_ice_in = SHR_CONST_CPICE, & + cp_ocn_in = SHR_CONST_CPSW, & + gravit_in = SHR_CONST_G, & + rhofresh_in = SHR_CONST_RHOFW, & + zvir_in = SHR_CONST_ZVIR, & + vonkar_in = SHR_CONST_KARMAN, & + cp_wv_in = SHR_CONST_CPWV, & + stefan_boltzmann_in = SHR_CONST_STEBOL, & + Tffresh_in = SHR_CONST_TKFRZ, & + Lsub_in = SHR_CONST_LATSUB, & + Lvap_in = SHR_CONST_LATVAP, & + !Lfresh_in = SHR_CONST_LATICE, & ! computed in init_parameters as Lsub-Lvap + Timelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & + Tsmelt_in = SHR_CONST_TKFRZ-SHR_CONST_TKFRZ, & + ice_ref_salinity_in = SHR_CONST_ICE_REF_SAL, & + depressT_in = 0.054_dbl_kind, & + Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & + pi_in = SHR_CONST_PI, & + snowpatch_in = 0.005_dbl_kind, & + dragio_in = 0.00962_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -382,6 +395,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Get orbital values ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 ! if CESMCOUPLED is not defined +#ifdef CESMCOUPLED + call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#else call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then @@ -403,11 +420,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) read(cvalue,*) mvelpp end if - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, & - lambm0_in=lambm0, obliqr_in=obliqr) + call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif ! Determine runtype and possibly nextsw_cday call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, isPresent=isPresent, rc=rc) @@ -429,7 +446,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! In the nuopc version it will be easier to assume that on startup - nextsw_cday is just the current time ! TOOD (mvertens, 2019-03-21): need to get the perpetual run working - + if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization nextsw_cday = -1.0_r8 @@ -441,7 +458,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if else ! This would be the NEMS branch - ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is + ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is ! simply a CPP variable declaratino of NEMSCOUPLED runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined @@ -876,7 +893,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#ifdef CESMCOUPLED +#ifdef CESMCOUPLED !----------------------------------------------------------------- ! Prescribed ice initialization - first get compid !----------------------------------------------------------------- @@ -1024,6 +1041,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! Obtain orbital values !-------------------------------- +#ifdef CESMCOUPLED + call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#else call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then @@ -1050,6 +1071,7 @@ subroutine ModelAdvance(gcomp, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif !-------------------------------- ! check that cice internal time is in sync with master clock before timestep update @@ -1349,4 +1371,142 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize + !=============================================================================== + + subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) + + !---------------------------------------------------------- + ! Initialize orbital related values for cesm coupled + !---------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + integer , intent(out) :: rc ! output error + + ! local variables + real(r8) :: eccen, obliqr, lambm0, mvelpp + character(len=CL) :: msgstr ! temporary + character(len=CL) :: cvalue ! temporary + type(ESMF_Time) :: CurrTime ! current time + integer :: year ! model year at current time + integer :: orb_year ! orbital year for current orbital computation + logical :: lprint + logical :: first_time = .true. + character(len=*) , parameter :: subname = "(cice_orbital_init)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (first_time) then + + ! Determine orbital attributes from input + call NUOPC_CompAttributeGet(gcomp, name='orb_mode', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mode + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear + call NUOPC_CompAttributeGet(gcomp, name="orb_iyear_align", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear_align + call NUOPC_CompAttributeGet(gcomp, name="orb_obliq", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_obliq + call NUOPC_CompAttributeGet(gcomp, name="orb_eccen", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_eccen + call NUOPC_CompAttributeGet(gcomp, name="orb_mvelp", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mvelp + + ! Error checks + if (trim(orb_mode) == trim(orb_fixed_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear + write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_variable_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then + !-- force orb_iyear to undef to make sure shr_orb_params works properly + orb_iyear = SHR_ORB_UNDEF_INT + orb_iyear_align = SHR_ORB_UNDEF_INT + if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & + orb_obliq == SHR_ORB_UNDEF_REAL .or. & + orb_mvelp == SHR_ORB_UNDEF_REAL) then + if (mastertask) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: orb_eccen = ',orb_eccen + write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq + write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + end if + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + rc = ESMF_FAILURE + return ! bail out + endif + end if + + if (trim(orb_mode) == trim(orb_variable_year)) then + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(CurrTime, yy=year, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + orb_year = orb_iyear + (year - orb_iyear_align) + lprint = mastertask + else + orb_year = orb_iyear + if (first_time) then + lprint = mastertask + else + lprint = .false. + end if + end if + + eccen = orb_eccen + call shr_orb_params(orb_year, eccen, orb_obliq, orb_mvelp, obliqr, lambm0, mvelpp, lprint) + + if ( eccen == SHR_ORB_UNDEF_REAL .or. obliqr == SHR_ORB_UNDEF_REAL .or. & + mvelpp == SHR_ORB_UNDEF_REAL .or. lambm0 == SHR_ORB_UNDEF_REAL) then + write (msgstr, *) subname//' ERROR: orb params incorrect' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + first_time = .false. + + end subroutine ice_orbital_init + end module ice_comp_nuopc From 10e7c203d9492eca34787e284edd8e0159f75e6e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 29 Apr 2020 16:36:09 -0600 Subject: [PATCH 03/44] fixed problems in updated orbital calculations needed for cesm --- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 2 +- cicecore/drivers/nuopc/cmeps/ice_import_export.F90 | 8 ++------ cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 | 2 +- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 09cffa0c7..f5e7de02f 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -374,7 +374,7 @@ subroutine coupling_prep (iblk) fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai + fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai, & fnit, fsil, famm, fdmsp, fdms, fhum, fdust, falgalN, & fdoc, fdic, fdon, ffep, ffed, bgcflux_ice_to_ocn use ice_grid, only: tmask diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 0fe2510aa..5e423fbb6 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -1039,7 +1039,6 @@ subroutine ice_export( exportState, rc ) lmask=tmask, ifrac=ailohi, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif -#endif ! ------ ! optional short wave penetration to ocean ice category @@ -1056,11 +1055,12 @@ subroutine ice_export( exportState, rc ) ! penetrative shortwave by category ! Note: no need zero out pass-through fields over land for benefit of x2oacc fields in cpl hist files since ! the export state has been zeroed out at the beginning - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=aicen_init, index=n, & + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ifrac_n', input=fswthrun_ai, index=n, & lmask=tmask, ifrac=ailohi, ungridded_index=n, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if +#endif end subroutine ice_export @@ -1488,10 +1488,6 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, if (geomtype == ESMF_GEOMTYPE_MESH) then - if (present(ungridded_index)) then - write(6,*)'DEBUG: fldname = ',trim(fldname),' has ungridded index= ',ungridded_index - end if - ! get field pointer if (present(ungridded_index)) then call state_getfldptr(state, trim(fldname), dataPtr2d, rc) diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index f597015f3..4c3876f6c 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -49,7 +49,7 @@ module ice_prescribed_mod ! !PUBLIC DATA MEMBERS: logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - integer(SHR_KIND_IN),parameter :: nFilesMaximum = 400 ! max number of files + integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files integer(kind=int_kind) :: stream_year_first ! first year in stream to use integer(kind=int_kind) :: stream_year_last ! last year in stream to use integer(kind=int_kind) :: model_year_align ! align stream_year_first From ce8e5a97d051dd9ff4715f6eec6829271d774836 Mon Sep 17 00:00:00 2001 From: apcraig Date: Sat, 9 May 2020 21:29:22 -0600 Subject: [PATCH 04/44] update CICE6 to support coupling with UFS --- cicecore/cicedynB/general/ice_init.F90 | 4 +- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 2 +- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 4 + .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 206 ++++++++++++------ .../drivers/nuopc/cmeps/ice_import_export.F90 | 72 +++++- .../nuopc/cmeps/ice_prescribed_mod.F90 | 11 +- .../drivers/nuopc/cmeps/ice_shr_methods.F90 | 80 +++---- configuration/scripts/Makefile | 23 +- configuration/scripts/cice.build | 15 +- forapps/ufs/comp_ice.backend.clean | 42 ++++ forapps/ufs/comp_ice.backend.libcice | 142 ++++++++++++ 11 files changed, 479 insertions(+), 122 deletions(-) create mode 100755 forapps/ufs/comp_ice.backend.clean create mode 100755 forapps/ufs/comp_ice.backend.libcice diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index ffb070644..6ffe3d05c 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -276,7 +276,7 @@ subroutine input_data kmt_file = 'unknown_kmt_file' version_name = 'unknown_version_name' ncat = 0 ! number of ice thickness categories - nfsd = 0 ! number of floe size categories (1 = default) + nfsd = 1 ! number of floe size categories (1 = default) nilyr = 0 ! number of vertical ice layers nslyr = 0 ! number of vertical snow layers nblyr = 0 ! number of bio layers @@ -748,7 +748,7 @@ subroutine input_data ice_ic /= 'none' .and. ice_ic /= 'default') then if (my_task == master_task) then write(nu_diag,*) subname//' ERROR: runtype, restart, ice_ic are inconsistent:' - write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), 'restart=',restart, 'ice_ic=',trim(ice_ic) + write(nu_diag,*) subname//' ERROR: runtype=',trim(runtype), ' restart=',restart, ' ice_ic=',trim(ice_ic) write(nu_diag,*) subname//' ERROR: Please review user guide' endif abort_flag = 1 diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index b72745e30..16e4216e6 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -204,9 +204,9 @@ subroutine cice_init(mpicom_ice) ! coupler communication or forcing data initialization !-------------------------------------------------------------------- +#ifndef coupled call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled #ifndef CESMCOUPLED if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index f5e7de02f..aed00a9a0 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -15,7 +15,9 @@ module CICE_RunMod use ice_kinds_mod +#ifdef CESMCOUPLED use perf_mod, only : t_startf, t_stopf, t_barrierf +#endif use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 @@ -207,12 +209,14 @@ subroutine ice_step call init_history_bgc call ice_timer_stop(timer_diags) ! diagnostics/history +#ifdef CESMCOUPLED if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') call ice_prescribed_run(idate, sec) call t_stopf ('cice_run_presc') endif +#endif call save_init diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index 49218ffe3..e4c2a3802 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,13 +15,12 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort, shr_sys_flush +#ifdef CESMCOUPLED use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_string_mod , only : shr_string_listGetNum use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian +#endif use ice_constants , only : ice_init_constants use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use ice_shr_methods , only : set_component_logging, get_component_instance @@ -38,15 +37,17 @@ module ice_comp_nuopc use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep - use ice_kinds_mod , only : dbl_kind, int_kind, char_len + use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_scam , only : scmlat, scmlon, single_column - use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits + use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist #if (defined NEWCODE) use ice_history_shared , only : model_doi_url ! TODO: add this functionality #endif +#ifdef CESMCOUPLED use ice_prescribed_mod , only : ice_prescribed_init +#endif #if (defined NEWCODE) use ice_atmo , only : flux_convergence_tolerance, flux_convergence_max_iteration use ice_atmo , only : use_coldair_outbreak_mod @@ -55,12 +56,15 @@ module ice_comp_nuopc use CICE_RunMod , only : CICE_Run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters + use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters +#ifdef CESMCOUPLED use perf_mod , only : t_startf, t_stopf, t_barrierf +#endif use ice_timers implicit none + private public :: SetServices public :: SetVM @@ -71,20 +75,22 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize +#ifdef CESMCOUPLED private :: ice_orbital_init ! only for cesm +#endif - character(len=CL) :: flds_scalar_name = '' + character(len=char_len_long) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 integer :: flds_scalar_index_nextsw_cday = 0 - character(len=CL) :: orb_mode ! attribute - orbital mode + character(len=char_len_long) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year - real(R8) :: orb_obliq ! attribute - obliquity in degrees - real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees + real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' @@ -182,8 +188,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables - character(len=CL) :: cvalue - character(len=CL) :: logmsg + character(len=char_len_long) :: cvalue + character(len=char_len_long) :: logmsg logical :: isPresent, isSet character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -195,7 +201,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + call abort_ice(subname//'Need to set attribute ScalarFieldName') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -206,7 +212,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + call abort_ice(subname//'Need to set attribute ScalarFieldCount') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -217,7 +223,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxGridNX') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -228,7 +234,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxGridNY') endif call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -239,7 +245,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') + call abort_ice(subname//'Need to set attribute ScalarFieldIdxNextSwCday') endif call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) @@ -263,15 +269,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_Mesh) :: Emesh, EmeshTemp integer :: spatialDim integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - real(r8), pointer :: lat(:), latMesh(:) - real(r8), pointer :: lon(:), lonMesh(:) + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) integer , allocatable :: gindex_ice(:) integer , allocatable :: gindex_elim(:) integer , allocatable :: gindex(:) integer :: globalID character(ESMF_MAXSTR) :: cvalue - real(r8) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len) :: tfrz_option character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_VM) :: vm @@ -295,7 +301,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: dtime ! time step integer :: lmpicom integer :: shrlogunit ! original log unit - character(len=cs) :: starttype ! infodata start type + character(len=char_len) :: starttype ! infodata start type integer :: lsize ! local size of coupling array character(len=512) :: diro character(len=512) :: logfile @@ -307,8 +313,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain type(block) :: this_block ! block information for current block integer :: compid ! component id - character(len=CL) :: tempc1,tempc2 - real(R8) :: diff_lon + character(len=char_len_long) :: tempc1,tempc2 + real(dbl_kind) :: diff_lon integer :: npes integer :: num_elim_global integer :: num_elim_local @@ -350,12 +356,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! start cice timers !---------------------------------------------------------------------------- +#ifdef CESMCOUPLED call t_startf ('cice_init_total') +#endif !---------------------------------------------------------------------------- ! Initialize constants !---------------------------------------------------------------------------- +#ifdef CESMCOUPLED call ice_init_constants(omega_in=SHR_CONST_OMEGA, radius_in=SHR_CONST_REARTH, & spval_dbl_in=SHR_CONST_SPVAL) @@ -387,6 +396,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif !---------------------------------------------------------------------------- ! Determine attributes - also needed in realize phase to get grid information @@ -399,23 +409,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else + ! Start with icepack values then update with values defined in configure file if they exist + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) eccen end if call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) obliqr end if call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) lambm0 end if call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) mvelpp end if @@ -438,7 +454,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (trim(starttype) == trim('branch')) then runtype = "continue" else - call shr_sys_abort( subname//' ERROR: unknown starttype' ) + call abort_ice( subname//' ERROR: unknown starttype' ) end if ! Note that in the mct version the atm was initialized first so that nextsw_cday could be passed to the other @@ -449,7 +465,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization - nextsw_cday = -1.0_r8 + nextsw_cday = -1.0_dbl_kind else call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -464,14 +480,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if + single_column = .false. +#ifdef CESMCOUPLED ! Determine single column info call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) single_column - else - single_column = .false. end if +#endif if (single_column) then ! Must have these attributes present call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) @@ -484,14 +501,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Determine runid call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) runid else runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined end if +#ifdef CESMCOUPLED ! Determine tfreeze_option, flux convertence before call to cice_init + ! tcx, what is going on here? if not present, set it? if present, ignore it? call NUOPC_CompAttributeGet(gcomp, name="tfreeze_option", value=tfrz_option, isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent) then @@ -501,6 +519,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) +#endif #if (defined NEWCODE) call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, isPresent=isPresent, rc=rc) @@ -508,7 +527,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (isPresent) then read(cvalue,*) flux_convergence_tolerance else - flux_convergence_tolerance = 0._r8 + flux_convergence_tolerance = 0._dbl_kind end if call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) @@ -537,19 +556,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,curr_ymd) + call ice_cal_ymd2date(yy,mm,dd,curr_ymd) call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,start_ymd) + call ice_cal_ymd2date(yy,mm,dd,start_ymd) call ESMF_TimeGet( stopTime, yy=yy, mm=mm, dd=dd, s=stop_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,stop_ymd) + call ice_cal_ymd2date(yy,mm,dd,stop_ymd) call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yy,mm,dd,ref_ymd) + call ice_cal_ymd2date(yy,mm,dd,ref_ymd) call ESMF_TimeIntervalGet( timeStep, s=dtime, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -558,13 +577,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar_type = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar_type = shr_cal_gregorian else - call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) + call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if +#endif !---------------------------------------------------------------------------- ! Set cice logging @@ -572,11 +593,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later +#ifdef CESMCOUPLED call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nu_diag_set = .true. +#endif +#ifdef CESMCOUPLED call shr_file_setLogUnit (shrlogunit) +#endif !---------------------------------------------------------------------------- ! Initialize cice @@ -585,9 +610,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that cice_init also sets time manager info as well as mpi communicator info, ! including master_task and my_task +#ifdef CESMCOUPLED call t_startf ('cice_init') +#endif call cice_init( lmpicom ) +#ifdef CESMCOUPLED call t_stopf ('cice_init') +#endif !---------------------------------------------------------------------------- ! reset shr logging to my log file @@ -647,7 +676,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate end if - call shr_sys_abort(subname//' :: ERROR idate lt zero') + call abort_ice(subname//' :: ERROR idate lt zero') endif iyear = (idate/10000) ! integer year of basedate month = (idate-iyear*10000)/100 ! integer month of basedate @@ -658,12 +687,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif - if (calendar_type /= "GREGORIAN") then - call time2sec(iyear-year_init,month,mday,time) - else + if (calendar_type == "GREGORIAN" .or. & + calendar_type == "Gregorian" .or. & + calendar_type == "gregorian") then call time2sec(iyear-(year_init-1),month,mday,time) + else + call time2sec(iyear-year_init,month,mday,time) endif time = time+start_tod end if @@ -867,16 +899,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! error check differences between internally generated lons and those read in do n = 1,lsize diff_lon = abs(lonMesh(n) - lon(n)) - if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360_r8) > 1.e-1) .or.& - (diff_lon > 1.e-3 .and. diff_lon < 1._r8) ) then + if ( (diff_lon > 1.e2 .and. abs(diff_lon - 360_dbl_kind) > 1.e-1) .or.& + (diff_lon > 1.e-3 .and. diff_lon < 1._dbl_kind) ) then !write(6,100)n,lonMesh(n),lon(n), diff_lon 100 format('ERROR: CICE n, lonmesh(n), lon(n), diff_lon = ',i6,2(f21.13,3x),d21.5) - !call shr_sys_abort() + !call abort_ice() end if if (abs(latMesh(n) - lat(n)) > 1.e-1) then !write(6,101)n,latMesh(n),lat(n), abs(latMesh(n)-lat(n)) 101 format('ERROR: CICE n, latmesh(n), lat(n), diff_lat = ',i6,2(f21.13,3x),d21.5) - !call shr_sys_abort() + !call abort_ice() end if end do @@ -952,12 +984,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) +#ifdef CESMCOUPLED call t_stopf ('cice_init_total') +#endif deallocate(gindex_ice) deallocate(gindex) - call shr_sys_flush(nu_diag) + call flush_fileunit(nu_diag) end subroutine InitializeRealize @@ -980,7 +1014,7 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nextTime type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue - real(r8) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp integer :: shrlogunit ! original log unit integer :: k,n ! index logical :: stop_now ! .true. ==> stop at the end of this run phase @@ -994,8 +1028,8 @@ subroutine ModelAdvance(gcomp, rc) integer :: mon_sync ! Sync current month integer :: day_sync ! Sync current day integer :: tod_sync ! Sync current time of day (sec) - character(CL) :: restart_date - character(CL) :: restart_filename + character(char_len_long) :: restart_date + character(char_len_long) :: restart_filename logical :: isPresent character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' @@ -1009,15 +1043,19 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call ice_timer_start(timer_total) ! time entire run +#ifdef CESMCOUPLED call t_barrierf('cice_run_total_BARRIER',mpi_comm_ice) call t_startf ('cice_run_total') +#endif !-------------------------------- ! Reset shr logging to my log file !-------------------------------- +#ifdef CESMCOUPLED call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (nu_diag) +#endif !-------------------------------- ! Query the Component for its clock, importState and exportState @@ -1045,23 +1083,30 @@ subroutine ModelAdvance(gcomp, rc) call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else + ! Start with icepack values then update with values defined in configure file if they exist + ! tcx, This should be identical with initialization, why do it again? Get rid of it + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) eccen end if call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) obliqr end if call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) lambm0 end if call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then read(cvalue,*) mvelpp end if @@ -1086,7 +1131,7 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) + call ice_cal_ymd2date(yr_sync, mon_sync, day_sync, ymd_sync) ! error check if ( (ymd /= ymd_sync) .or. (tod /= tod_sync) ) then @@ -1130,15 +1175,19 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- +#ifdef CESMCOUPLED call t_barrierf('cice_run_import_BARRIER',mpi_comm_ice) call t_startf ('cice_run_import') call ice_timer_start(timer_cplrecv) +#endif call ice_import(importState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED call ice_timer_stop(timer_cplrecv) call t_stopf ('cice_run_import') +#endif ! write Debug output if (debug_import > 0 .and. my_task==master_task) then @@ -1161,15 +1210,19 @@ subroutine ModelAdvance(gcomp, rc) ! Create export state !-------------------------------- +#ifdef CESMCOUPLED call t_barrierf('cice_run_export_BARRIER',mpi_comm_ice) call t_startf ('cice_run_export') call ice_timer_start(timer_cplsend) +#endif call ice_export(exportState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CESMCOUPLED call ice_timer_stop(timer_cplsend) call t_stopf ('cice_run_export') +#endif if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & @@ -1177,8 +1230,10 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if +#ifdef CESMCOUPLED ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) +#endif !-------------------------------- ! stop timers and print timer info @@ -1202,7 +1257,9 @@ subroutine ModelAdvance(gcomp, rc) stop_now = .false. endif +#ifdef CESMCOUPLED call t_stopf ('cice_run_total') +#endif ! Need to stop this at the end of every run phase in a coupled run. call ice_timer_stop(timer_total) @@ -1373,6 +1430,7 @@ end subroutine ModelFinalize !=============================================================================== +#ifdef CESMCOUPLED subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) !---------------------------------------------------------- @@ -1387,9 +1445,9 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables - real(r8) :: eccen, obliqr, lambm0, mvelpp - character(len=CL) :: msgstr ! temporary - character(len=CL) :: cvalue ! temporary + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + character(len=char_len_long) :: msgstr ! temporary + character(len=char_len_long) :: cvalue ! temporary type(ESMF_Time) :: CurrTime ! current time integer :: year ! model year at current time integer :: orb_year ! orbital year for current orbital computation @@ -1508,5 +1566,31 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) first_time = .false. end subroutine ice_orbital_init +#endif + !=============================================================================== + + subroutine ice_cal_ymd2date(year, month, day, date) + + implicit none + + ! !INPUT/OUTPUT PARAMETERS: + + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + + !--- local --- + character(*),parameter :: subName = "(ice_cal_ymd2date)" + + !------------------------------------------------------------------------------- + ! NOTE: + ! this calendar has a year zero (but no day or month zero) + !------------------------------------------------------------------------------- + + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + + end subroutine ice_cal_ymd2date + + !=============================================================================== end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 5e423fbb6..b253c0123 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -3,10 +3,10 @@ module ice_import_export use ESMF use NUOPC use NUOPC_Model - use shr_sys_mod , only : shr_sys_abort, shr_sys_flush +#ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use ice_kinds_mod , only : int_kind, dbl_kind, char_len_long, log_kind +#endif + use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind use ice_constants , only : c0, c1, spval_dbl use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector use ice_blocks , only : block, get_block, nx_block, ny_block @@ -23,7 +23,7 @@ module ice_import_export use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt - use ice_flux , only : sss, tf, wind, fsw + use ice_flux , only : sss, Tf, wind, fsw #if (defined NEWCODE) use ice_flux , only : faero_atm, faero_ocn use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap @@ -33,13 +33,16 @@ module ice_import_export use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac use ice_grid , only : grid_type, t2ugrid_vector use ice_boundary , only : ice_HaloUpdate - use ice_fileunits , only : nu_diag + use ice_fileunits , only : nu_diag, flush_fileunit use ice_communicate , only : my_task, master_task, MPI_COMM_ICE use ice_prescribed_mod , only : prescribed_ice use ice_shr_methods , only : chkerr, state_reset use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags + use icepack_intfc , only : icepack_liquidus_temperature +#ifdef CESMCOUPLED use perf_mod , only : t_startf, t_stopf, t_barrierf +#endif implicit none public @@ -107,8 +110,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam ! local variables integer :: n - character(CS) :: stdname - character(CS) :: cvalue + character(char_len) :: stdname + character(char_len) :: cvalue logical :: flds_wiso ! use case logical :: flds_i2o_per_cat ! .true. => select per ice thickness category character(len=*), parameter :: subname='(ice_import_export:ice_advertise_fields)' @@ -117,6 +120,9 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + flds_wiso = .false. + flds_i2o_per_cat = .false. +#ifdef CESMCOUPLED call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso @@ -127,6 +133,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) send_i2x_per_cat call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) +#endif #endif !----------------- @@ -154,7 +161,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' ) @@ -163,6 +170,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' ) +#ifdef CESMCOUPLED ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) @@ -171,6 +179,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam ! from - atm dry dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) +#endif do n = 1,fldsToIce_num call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & @@ -231,9 +240,11 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_merid' ) +#ifdef CESMCOUPLED call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) +#endif if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) @@ -388,6 +399,7 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +!tcx errr.... this needs to be fixed in the dictionary!!! call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -431,9 +443,13 @@ subroutine ice_import( importState, rc ) ! perform a halo update if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') +#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_scalar) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') +#endif endif ! now fill in the ice internal data types @@ -485,9 +501,13 @@ subroutine ice_import( importState, rc ) if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') +#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_vector) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') +#endif endif !$OMP PARALLEL DO PRIVATE(iblk,i,j) @@ -600,7 +620,9 @@ subroutine ice_import( importState, rc ) ! interpolate across the pole) ! use ANGLET which is on the T grid ! +#ifdef CESMCOUPLED call t_startf ('cice_imp_ocn') +#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks @@ -624,33 +646,47 @@ subroutine ice_import( importState, rc ) sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) sss(i,j,iblk) = max(sss(i,j,iblk),c0) +#ifndef CESMCOUPLED +!tcx should this be icepack_sea_freezing_temperature? + Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) +#endif enddo enddo - ! Use shr_frz_mod for this +#ifdef CESMCOUPLED + ! Use shr_frz_mod for this, overwrite Tf computed above Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) +#endif enddo !$OMP END PARALLEL DO +#ifdef CESMCOUPLED call t_stopf ('cice_imp_ocn') +#endif ! Interpolate ocean dynamics variables from T-cell centers to ! U-cell centers. if (.not.prescribed_ice) then +#ifdef CESMCOUPLED call t_startf ('cice_imp_t2u') +#endif call t2ugrid_vector(uocn) call t2ugrid_vector(vocn) call t2ugrid_vector(ss_tltx) call t2ugrid_vector(ss_tlty) +#ifdef CESMCOUPLED call t_stopf ('cice_imp_t2u') +#endif end if ! Atmosphere variables are needed in T cell centers in ! subroutine stability and are interpolated to the U grid ! later as necessary. +#ifdef CESMCOUPLED call t_startf ('cice_imp_atm') +#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks do j = 1, ny_block @@ -671,7 +707,9 @@ subroutine ice_import( importState, rc ) enddo enddo !$OMP END PARALLEL DO +#ifdef CESMCOUPLED call t_stopf ('cice_imp_atm') +#endif end subroutine ice_import @@ -787,7 +825,7 @@ subroutine ice_export( exportState, rc ) if (tmask(i,j,iblk) .and. ailohi(i,j,iblk) < c0 ) then write(nu_diag,*) & ' (ice) send: ERROR ailohi < 0.0 ',i,j,ailohi(i,j,iblk) - call shr_sys_flush(nu_diag) + call flush_fileunit(nu_diag) endif end do end do @@ -1083,7 +1121,7 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound num = num + 1 if (num > fldsMax) then - call shr_sys_abort(trim(subname)//": ERROR num > fldsMax "//trim(stdname)) + call abort_ice(trim(subname)//": ERROR num > fldsMax "//trim(stdname)) endif fldlist(num)%stdname = trim(stdname) @@ -1270,6 +1308,9 @@ subroutine state_getimport_4d_output(state, fldname, output, index, do_sum, ungr rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1381,6 +1422,9 @@ subroutine state_getimport_3d_output(state, fldname, output, do_sum, ungridded_i rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1486,6 +1530,9 @@ subroutine state_setexport_4d_input(state, fldname, input, index, lmask, ifrac, rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer @@ -1600,6 +1647,9 @@ subroutine state_setexport_3d_input(state, fldname, input, lmask, ifrac, ungridd rc = ESMF_SUCCESS + ! check that fieldname exists + if (.not. State_FldChk(state, trim(fldname))) return + if (geomtype == ESMF_GEOMTYPE_MESH) then ! get field pointer diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 4c3876f6c..dd56ac441 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -1,6 +1,15 @@ module ice_prescribed_mod -#ifdef CESMCOUPLED +#ifndef CESMCOUPLED + + use ice_kinds_mod + + implicit none + private ! except + + logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice + +#else ! !DESCRIPTION: ! The prescribed ice model reads in ice concentration data from a netCDF diff --git a/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 b/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 index 24a4226e5..323cba9a4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_shr_methods.F90 @@ -20,9 +20,11 @@ module ice_shr_methods use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort + use ice_kinds_mod, only : r8 => dbl_kind, cl=>char_len_long, cs=>char_len + use ice_exit , only : abort_ice +#ifdef CESMCOUPLED use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit +#endif implicit none private @@ -89,9 +91,11 @@ subroutine memcheck(string, level, mastertask) character(len=*), parameter :: subname='(memcheck)' !----------------------------------------------------------------------- +#ifdef CESMCOUPLED if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif +#endif end subroutine memcheck @@ -160,7 +164,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) logUnit = 6 endif +#ifdef CESMCOUPLED call shr_file_setLogUnit (logunit) +#endif end subroutine set_component_logging @@ -710,10 +716,10 @@ subroutine alarmInit( clock, alarm, option, & case (optDate) if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + call abort_ice(subname//trim(option)//' requires opt_ymd') end if if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + call abort_ice(subname//trim(option)//'opt_ymd, opt_tod invalid') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -723,13 +729,13 @@ subroutine alarmInit( clock, alarm, option, & case (optIfdays0) if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + call abort_ice(subname//trim(option)//' requires opt_ymd') end if if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -739,10 +745,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSteps) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -750,8 +756,8 @@ subroutine alarmInit( clock, alarm, option, & update_nextalarm = .true. case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') + if (.not.present(opt_n)) call abort_ice(subname//trim(option)//' requires opt_n') + if (opt_n <= 0) call abort_ice(subname//trim(option)//' invalid opt_n') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n @@ -759,10 +765,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSeconds) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -771,10 +777,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNSecond) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -784,20 +790,20 @@ subroutine alarmInit( clock, alarm, option, & case (optNMinutes) call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. case (optNMinute) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -806,10 +812,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNHours) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -818,10 +824,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNHour) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -830,10 +836,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNDays) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -842,10 +848,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNDay) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -854,10 +860,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNMonths) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -866,10 +872,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNMonth) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -885,10 +891,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNYears) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -897,10 +903,10 @@ subroutine alarmInit( clock, alarm, option, & case (optNYear) if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') + call abort_ice(subname//trim(option)//' requires opt_n') end if if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call abort_ice(subname//trim(option)//' invalid opt_n') end if call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -915,7 +921,7 @@ subroutine alarmInit( clock, alarm, option, & update_nextalarm = .true. case default - call shr_sys_abort(subname//'unknown option '//trim(option)) + call abort_ice(subname//'unknown option '//trim(option)) end select @@ -964,7 +970,7 @@ subroutine timeInit( Time, ymd, cal, tod, rc) rc = ESMF_SUCCESS if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + call abort_ice( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) end if tdate = abs(date) diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 88a5030d1..7b39d5c8d 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -16,7 +16,8 @@ # # Usage examples: # % gmake -j 8 VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -# -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.conrad_intel +# -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.conrad_intel \ +# DEPFILE=${ICE_CASEDIR}/makdep.c cice #------------------------------------------------------------------------------- #------------------------------------------------------------------------------- @@ -25,6 +26,7 @@ EXEC := a.out MACFILE := NONE +DEPFILE := NONE MODEL := NONE VPFILE := NONE VPATH := . @@ -33,6 +35,13 @@ SRCS := NONE # dependency generator DEPGEN := ./makdep +OBJS_DEPGEN := $(DEPFILE) + +ifneq ($(ESMFMKFILE),) + -include $(ESMFMKFILE) + INCLDIR += $(ESMF_F90COMPILEPATHS) + SLIBS += $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) +endif ifneq ($(VPATH),.) # this variable was specified on cmd line or in an env var @@ -59,14 +68,14 @@ endif OBJS := $(addsuffix .o, $(sort $(basename $(notdir $(SRCS))))) DEPS := $(addsuffix .d, $(sort $(basename $(notdir $(SRCS))))) INCS := $(patsubst %,-I%, $(VPATH) ) -OBJS_DEPGEN := $(addprefix $(ICE_CASEDIR)/,$(addsuffix .c, $(notdir $(DEPGEN)))) MODDIR:= -I. RM := rm +AR := ar .SUFFIXES: .SUFFIXES: .F90 .F .c .o -.PHONY: all cice targets target db_files db_flags clean realclean +.PHONY: all cice libcice targets target db_files db_flags clean realclean all: $(EXEC) cice: $(EXEC) @@ -83,7 +92,7 @@ cice: $(EXEC) targets: @echo " " - @echo "Supported Makefile Targets are: cice, makdep, depends, clean, realclean, targets, db_files, db_flags" + @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean, targets, db_files, db_flags" target: targets db_files: @@ -100,6 +109,7 @@ db_files: @echo "* ULIBS := $(ULIBS)" @echo "* SLIBS := $(SLIBS)" @echo "* INCLDIR := $(INCLDIR)" + @echo "* DEPFILE := $(DEPFILE)" @echo "* OBJS_DEPGEN := $(OBJS_DEPGEN)" db_flags: @echo " " @@ -112,6 +122,7 @@ db_flags: @echo "* .c.o := $(CC) $(CFLAGS) $(CPPDEFS) $(INCLDIR)" @echo "* .F.o := $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(CPPDEFS) $(INCLDIR)" @echo "* .F90.o := $(FC) -c $(FFLAGS) $(FREEFLAGS) $(CPPDEFS) $(MODDIR) $(INCLDIR)" + @echo "* libcice := $(AR) -r $(EXEC) " @echo "* $(notdir $(EXEC)) := $(LD) $(LDFLAGS) $(ULIBS) $(SLIBS)" #------------------------------------------------------------------------------- @@ -130,6 +141,10 @@ $(DEPGEN): $(OBJS_DEPGEN) $(EXEC): $(OBJS) $(LD) -o $(EXEC) $(LDFLAGS) $(OBJS) $(ULIBS) $(SLIBS) +libcice: $(OBJS) + @ echo "$(AR) -r $(EXEC) $(OBJS)" + $(AR) -r $(EXEC) $(OBJS) + .c.o: $(CC) $(CFLAGS) $(CPPDEFS) $(INCLDIR) $< diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index 2534bfa7e..eaa920ac4 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -147,7 +147,8 @@ endif if (${directmake} == 1) then echo "make ${target}" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} ${target} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} set bldstat = ${status} if (${bldstat} != 0) then echo "${0}: targeted make FAILED" @@ -172,10 +173,12 @@ if (${ICE_CLEANBUILD} == 'true') then echo "gmake clean" if (${quiet} == "true") then ${ICE_MACHINE_MAKE} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} clean >& ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c clean >& ${ICE_BLDLOG_FILE} else ${ICE_MACHINE_MAKE} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} clean |& tee ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c clean |& tee ${ICE_BLDLOG_FILE} endif endif @@ -183,11 +186,13 @@ echo "gmake cice" if (${quiet} == "true") then echo " quiet mode on... patience" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} >& ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c cice >& ${ICE_BLDLOG_FILE} set bldstat = ${status} else ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ - -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} |& tee ${ICE_BLDLOG_FILE} + -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ + DEPFILE=${ICE_CASEDIR}/makdep.c cice |& tee ${ICE_BLDLOG_FILE} set bldstat = ${status} endif diff --git a/forapps/ufs/comp_ice.backend.clean b/forapps/ufs/comp_ice.backend.clean new file mode 100755 index 000000000..7eef2ed1a --- /dev/null +++ b/forapps/ufs/comp_ice.backend.clean @@ -0,0 +1,42 @@ +#! /bin/csh -f + +### Expect to find the following environment variables set on entry: +# SITE +# SYSTEM_USERDIR +# SRCDIR +# EXEDIR + +setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR + +if (${SITE} =~ cheyenne*) then + setenv ARCH cheyenne_intel +#else if (${SITE} =~ Orion*) then +# setenv ARCH orion_intel +#else if (${SITE} =~ hera*) then +# setenv ARCH hera_intel +else + echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" + exit -2 +endif + +echo "CICE6 ${0}: ARCH = $ARCH" + +cd $OBJDIR + +setenv MAKENAME gmake +setenv MAKETHRDS 1 +setenv MAKEFILE ${SRCDIR}/configuration/scripts/Makefile +setenv MACROSFILE ${SRCDIR}/configuration/scripts/machines/Macros.$ARCH + +echo "CICE6 ${0}: EXEDIR = ${EXEDIR}" +echo "CICE6 ${0}: OBJDIR = ${OBJDIR}" +echo "CICE6 ${0}: MAKEFILE = ${MAKEFILE}" +echo "CICE6 ${0}: MACROSFILE = ${MACROSFILE}" +echo "CICE6 ${0}: ESMFMKFILE = ${ESMFMKFILE}" + +#clean +${MAKENAME} EXEC=${OBJDIR}/libcice6.a \ + -f ${MAKEFILE} MACFILE=${MACROSFILE} clean + +#clean install +rm -r -f ${BINDIR} diff --git a/forapps/ufs/comp_ice.backend.libcice b/forapps/ufs/comp_ice.backend.libcice new file mode 100755 index 000000000..eb1b8a4e7 --- /dev/null +++ b/forapps/ufs/comp_ice.backend.libcice @@ -0,0 +1,142 @@ +#! /bin/csh -f + +### Expect to find the following environment variables set on entry: +# SITE +# SYSTEM_USERDIR +# SRCDIR +# EXEDIR + +### local variable that begin with ICE_ are needed in the Macros file +# ICE_COMMDIR +# ICE_BLDDEBUG +# ICE_THREADED +# ICE_CPPDEFS + +setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR + +setenv THRD no # set to yes for OpenMP threading + +if (${SITE} =~ cheyenne*) then + setenv ARCH cheyenne_intel +#else if (${SITE} =~ Orion*) then +# setenv ARCH orion_intel +#else if (${SITE} =~ hera*) then +# setenv ARCH hera_intel +else + echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" + exit -2 +endif + +echo "CICE6 ${0}: ARCH = $ARCH" + +cd $OBJDIR + +setenv SHRDIR csm_share # location of CCSM shared code +setenv DRVDIR nuopc/cmeps + +#if ($NTASK == 1) then +# setenv ICE_COMMDIR serial +#else + setenv ICE_COMMDIR mpi +#endif + +if ($THRD == 'yes') then + setenv ICE_THREADED true +else + setenv ICE_THREADED false +endif + +if ($?ICE_CPPDEFS) then + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dcoupled" +else + setenv ICE_CPPDEFS "-Dcoupled" +endif + +if !($?IO_TYPE) then + setenv IO_TYPE netcdf4 # set to none if netcdf library is unavailable +endif +if ($IO_TYPE == 'netcdf3' || $IO_TYPE == 'netcdf4') then + setenv IODIR io_netcdf + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" +else if ($IO_TYPE == 'pio') then + setenv IODIR io_pio + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" +else + setenv IODIR io_binary +endif + +# Build in debug mode. If DEBUG=Y, enable DEBUG compilation. This +# flag is set in ${ROOTDIR}/coupledFV3_MOM6_CICE_debug.appBuilder file. +if (! $?DEBUG) then + setenv ICE_BLDDEBUG true +else + if ($DEBUG != "Y") then + setenv ICE_BLDDEBUG false + endif +endif +echo "CICE6 ${0}: DEBUG = ${ICE_BLDDEBUG}" + +### List of source code directories (in order of importance). +cat >! Filepath << EOF +${SRCDIR}/cicecore/drivers/${DRVDIR} +${SRCDIR}/cicecore/cicedynB/dynamics +${SRCDIR}/cicecore/cicedynB/general +${SRCDIR}/cicecore/cicedynB/analysis +${SRCDIR}/cicecore/cicedynB/infrastructure +${SRCDIR}/cicecore/cicedynB/infrastructure/io/${IODIR} +${SRCDIR}/cicecore/cicedynB/infrastructure/comm/${ICE_COMMDIR} +${SRCDIR}/cicecore/shared +${SRCDIR}/icepack/columnphysics +${SRCDIR}/$SHRDIR +EOF + +setenv MAKENAME gmake +setenv MAKETHRDS 1 +setenv MAKEFILE ${SRCDIR}/configuration/scripts/Makefile +setenv MACROSFILE ${SRCDIR}/configuration/scripts/machines/Macros.$ARCH +setenv DEPFILE ${SRCDIR}/configuration/scripts/makdep.c + +echo "CICE6 ${0}: EXEDIR = ${EXEDIR}" +echo "CICE6 ${0}: OBJDIR = ${OBJDIR}" +echo "CICE6 ${0}: MAKEFILE = ${MAKEFILE}" +echo "CICE6 ${0}: MACROSFILE = ${MACROSFILE}" +echo "CICE6 ${0}: DEPFILE = ${DEPFILE}" +echo "CICE6 ${0}: ESMFMKFILE = ${ESMFMKFILE}" + +#diagnostics +#${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} db_files +#${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} db_flags + +#clean +#${MAKENAME} VPFILE=Filepath EXEC=${OBJDIR}/cice \ +# -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} clean + +#needed to trigger a failed build to rest of system +rm ${BINDIR}/cice6.mk + +#build lib (includes dependencies) +${MAKENAME} -j ${MAKETHRDS} VPFILE=Filepath EXEC=${OBJDIR}/libcice6.a \ + -f ${MAKEFILE} MACFILE=${MACROSFILE} DEPFILE=${DEPFILE} libcice + +if ($status != 0) then + echo "CICE6 ${0}: gmake failed, exiting" + exit -2 +endif + +#install +mkdir -p ${BINDIR} +cp -f ${OBJDIR}/libcice6.a ${BINDIR}/ +cp -f ${OBJDIR}/ice_comp_nuopc.mod ${BINDIR}/ + +cat >! ${BINDIR}/cice6.mk << EOF +# ESMF self-describing build dependency makefile fragment + +ESMF_DEP_FRONT = ice_comp_nuopc +ESMF_DEP_INCPATH = ${BINDIR} +ESMF_DEP_CMPL_OBJS = +ESMF_DEP_LINK_OBJS = ${BINDIR}/libcice6.a + +EOF + From 53715eaffa8b6a543dbb126fe922c5232626fbe8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 24 May 2020 18:06:06 -0600 Subject: [PATCH 05/44] put in changes so that both ufsatm and cesm requirements for potential temperature and density are satisfied --- .../drivers/nuopc/cmeps/ice_import_export.F90 | 132 +++++++++++------- 1 file changed, 84 insertions(+), 48 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index b253c0123..083283895 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -3,9 +3,6 @@ module ice_import_export use ESMF use NUOPC use NUOPC_Model -#ifdef CESMCOUPLED - use shr_frz_mod , only : shr_frz_freezetemp -#endif use ice_kinds_mod , only : int_kind, dbl_kind, char_len, log_kind use ice_constants , only : c0, c1, spval_dbl use ice_constants , only : field_loc_center, field_type_scalar, field_type_vector @@ -19,16 +16,14 @@ module ice_import_export #if (defined NEWCODE) use ice_flux , only : fswthruvdr, fswthruvdf, fswthruidr, fswthruidf use ice_flux , only : send_i2x_per_cat, fswthrun_ai + use ice_flux , only : faero_atm, faero_ocn + use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap + use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn #endif use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt use ice_flux , only : sss, Tf, wind, fsw -#if (defined NEWCODE) - use ice_flux , only : faero_atm, faero_ocn - use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap - use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn -#endif use ice_state , only : vice, vsno, aice, aicen_init, trcr use ice_grid , only : tlon, tlat, tarea, tmask, anglet, hm, ocn_gridcell_frac use ice_grid , only : grid_type, t2ugrid_vector @@ -41,6 +36,7 @@ module ice_import_export use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature #ifdef CESMCOUPLED + use shr_frz_mod , only : shr_frz_freezetemp use perf_mod , only : t_startf, t_stopf, t_barrierf #endif @@ -127,7 +123,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) - #if (defined NEWCODE) call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -149,7 +144,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 's_surf' ) call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_zonal' ) call fldlist_add(fldsToIce_num, fldsToIce, 'ocn_current_merid' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'freezing_melting_potential') if (flds_wiso) then call fldlist_add(fldsToIce_num, fldsToIce, 'So_roce_wiso', ungridded_lbound=1, ungridded_ubound=3) end if @@ -160,8 +155,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'inst_merid_wind_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_spec_humid_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'inst_temp_height_lowest' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) - call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'inst_pres_height_lowest' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_ir_dir_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_sw_vis_dif_flx' ) @@ -169,6 +163,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'mean_down_lw_flx' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_prec_rate' ) call fldlist_add(fldsToIce_num, fldsToIce, 'mean_fprec_rate' ) + call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm + call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm #ifdef CESMCOUPLED ! from atm - black carbon deposition fluxes (3) @@ -348,7 +344,7 @@ subroutine ice_import( importState, rc ) integer , intent(out) :: rc ! local variables - integer,parameter :: nflds=15 + integer,parameter :: nflds=16 integer,parameter :: nfldv=6 integer :: i, j, iblk, n integer :: ilo, ihi, jlo, jhi !beginning and end of physical domain @@ -357,6 +353,7 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: inst_pres_height_lowest character(len=*), parameter :: subname = 'ice_import' !----------------------------------------------------- @@ -394,50 +391,56 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 's_surf', output=aflds, index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! import ocean states + ! import atm states call state_getimport(importState, 'inst_height_lowest', output=aflds, index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!tcx errr.... this needs to be fixed in the dictionary!!! - call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=5, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (State_FldChk(importState, 'Sa_ptem') .and. State_fldchk(importState, 'air_density_height_lowest')) then + call state_getimport(importState, 'Sa_ptem', output=aflds, index=4, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=5, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (State_FldChk(importState, 'inst_pres_height_lowest')) then + call state_getimport(importState, 'inst_pres_height_lowest', output=aflds, index=6, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call abort_ice(trim(subname)//& + ": ERROR either Sa_ptem and air_density_height_lowest OR inst_pres_height_lowest must be in import state") + end if - call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=6, rc=rc) + call state_getimport(importState, 'inst_temp_height_lowest', output=aflds, index=7, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'air_density_height_lowest', output=aflds, index=7, rc=rc) + call state_getimport(importState, 'inst_spec_humid_height_lowest', output=aflds, index=8, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import ocn/ice fluxes - call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=8, rc=rc) + call state_getimport(importState, 'freezing_melting_potential', output=aflds, index=9, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! import atm fluxes - call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=9, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dir_flx', output=aflds, index=10, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=10, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dir_flx', output=aflds, index=11, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=11, rc=rc) + call state_getimport(importState, 'mean_down_sw_vis_dif_flx', output=aflds, index=12, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=12, rc=rc) + call state_getimport(importState, 'mean_down_sw_ir_dif_flx', output=aflds, index=13, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=13, rc=rc) + call state_getimport(importState, 'mean_down_lw_flx', output=aflds, index=14, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate', output=aflds, index=14, rc=rc) + call state_getimport(importState, 'mean_prec_rate', output=aflds, index=15, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=15, rc=rc) + call state_getimport(importState, 'mean_fprec_rate', output=aflds, index=16, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! perform a halo update @@ -458,26 +461,59 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - sst (i,j,iblk) = aflds(i,j, 1,iblk) - sss (i,j,iblk) = aflds(i,j, 2,iblk) - zlvl (i,j,iblk) = aflds(i,j, 3,iblk) - potT (i,j,iblk) = aflds(i,j, 4,iblk) - Tair (i,j,iblk) = aflds(i,j, 5,iblk) - Qa (i,j,iblk) = aflds(i,j, 6,iblk) - rhoa (i,j,iblk) = aflds(i,j, 7,iblk) - frzmlt (i,j,iblk) = aflds(i,j, 8,iblk) - swvdr(i,j,iblk) = aflds(i,j, 9,iblk) - swidr(i,j,iblk) = aflds(i,j,10,iblk) - swvdf(i,j,iblk) = aflds(i,j,11,iblk) - swidf(i,j,iblk) = aflds(i,j,12,iblk) - flw (i,j,iblk) = aflds(i,j,13,iblk) - frain(i,j,iblk) = aflds(i,j,14,iblk) - fsnow(i,j,iblk) = aflds(i,j,15,iblk) - enddo !i - enddo !j - enddo !iblk + sst (i,j,iblk) = aflds(i,j, 1,iblk) + sss (i,j,iblk) = aflds(i,j, 2,iblk) + zlvl (i,j,iblk) = aflds(i,j, 3,iblk) + ! see below for 4,5,6 + Tair (i,j,iblk) = aflds(i,j, 7,iblk) + Qa (i,j,iblk) = aflds(i,j, 8,iblk) + frzmlt (i,j,iblk) = aflds(i,j, 9,iblk) + swvdr(i,j,iblk) = aflds(i,j,10,iblk) + swidr(i,j,iblk) = aflds(i,j,11,iblk) + swvdf(i,j,iblk) = aflds(i,j,12,iblk) + swidf(i,j,iblk) = aflds(i,j,13,iblk) + flw (i,j,iblk) = aflds(i,j,14,iblk) + frain(i,j,iblk) = aflds(i,j,15,iblk) + fsnow(i,j,iblk) = aflds(i,j,16,iblk) + end do + end do + end do !$OMP END PARALLEL DO + if ( State_fldChk(importState, 'Sa_ptem') .and. State_fldchk(importState,'air_density_height_lowest')) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + potT (i,j,iblk) = aflds(i,j, 4,iblk) + rhoa (i,j,iblk) = aflds(i,j, 5,iblk) + end do + end do + end do + !$OMP END PARALLEL DO + else if (State_fldChk(importState, 'inst_pres_height_lowest')) then + !$OMP PARALLEL DO PRIVATE(iblk,i,j) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + inst_pres_height_lowest = aflds(i,j,6,iblk) + if (inst_pres_height_lowest > 0.0_ESMF_KIND_R8) then + potT (i,j,iblk) = Tair(i,j,iblk) * (100000._ESMF_KIND_R8/inst_pres_height_lowest)**0.286_ESMF_KIND_R8 + else + potT (i,j,iblk) = 0.0_ESMF_KIND_R8 + end if + if (Tair(i,j,iblk) /= 0._ESMF_KIND_R8) then + rhoa(i,j,iblk) = inst_pres_height_lowest / & + (287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*Qa(i,j,iblk))*Tair(i,j,iblk)) + else + rhoa(i,j,iblk) = 0._ESMF_KIND_R8 + endif + end do !i + end do !j + end do !iblk + !$OMP END PARALLEL DO + end if + deallocate(aflds) allocate(aflds(nx_block,ny_block,nfldv,nblocks)) aflds = c0 From 3bb36945c210c5927a8cdd0e2b4cfaaaedb56be8 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 5 Jun 2020 13:32:44 -0400 Subject: [PATCH 06/44] Convergence on ustar for CICE. (#452) (#5) * Add atmiter_conv to CICE * Add documentation * trigger build the docs Co-authored-by: David A. Bailey --- cicecore/cicedynB/general/ice_init.F90 | 11 ++++++++--- configuration/scripts/ice_in | 1 + doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 3 ++- 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index e7820d0b7..289b70a9f 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -117,7 +117,7 @@ subroutine input_data ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, & 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 + phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound @@ -204,7 +204,8 @@ subroutine input_data namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & - highfreq, natmiter, ustar_min, emissivity, & + highfreq, natmiter, atmiter_conv, & + ustar_min, emissivity, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & @@ -357,6 +358,7 @@ subroutine input_data formdrag = .false. ! calculate form drag highfreq = .false. ! calculate high frequency RASM coupling natmiter = 5 ! number of iterations for atm boundary layer calcs + atmiter_conv = c0 ! ustar convergence criteria precip_units = 'mks' ! 'mm_per_month' or ! 'mm_per_sec' = 'mks' = kg/m^2 s tfrz_option = 'mushy' ! freezing temp formulation @@ -631,6 +633,7 @@ subroutine input_data call broadcast_scalar(formdrag, master_task) call broadcast_scalar(highfreq, master_task) call broadcast_scalar(natmiter, master_task) + call broadcast_scalar(atmiter_conv, master_task) call broadcast_scalar(update_ocn_f, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) @@ -1154,6 +1157,7 @@ subroutine input_data write(nu_diag,1010) ' formdrag = ', formdrag write(nu_diag,1010) ' highfreq = ', highfreq write(nu_diag,1020) ' natmiter = ', natmiter + write(nu_diag,1005) ' atmiter_conv = ', atmiter_conv write(nu_diag,1010) ' calc_strair = ', calc_strair write(nu_diag,1010) ' calc_Tsfc = ', calc_Tsfc @@ -1305,7 +1309,8 @@ subroutine input_data endif call icepack_init_parameters(ustar_min_in=ustar_min, albicev_in=albicev, albicei_in=albicei, & - albsnowv_in=albsnowv, albsnowi_in=albsnowi, natmiter_in=natmiter, emissivity_in=emissivity, & + albsnowv_in=albsnowv, albsnowi_in=albsnowi, natmiter_in=natmiter, atmiter_conv_in=atmiter_conv, & + emissivity_in=emissivity, & ahmax_in=ahmax, shortwave_in=shortwave, albedo_type_in=albedo_type, R_ice_in=R_ice, R_pnd_in=R_pnd, & R_snw_in=R_snw, dT_mlt_in=dT_mlt, rsnw_mlt_in=rsnw_mlt, & kstrength_in=kstrength, krdg_partic_in=krdg_partic, krdg_redist_in=krdg_redist, mu_rdg_in=mu_rdg, & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index ec984397a..d64960c6f 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -167,6 +167,7 @@ calc_Tsfc = .true. highfreq = .false. natmiter = 5 + atmiter_conv = 0.0d0 ustar_min = 0.0005 emissivity = 0.95 fbot_xfer_type = 'constant' diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index b78ac356d..e2920c839 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -61,6 +61,7 @@ either Celsius or Kelvin units). "ardgn", "fractional area of ridged ice", "" "aspect_rapid_mode", ":math:`\bullet` brine convection aspect ratio", "1" "astar", "e-folding scale for participation function", "0.05" + "atmiter_conv", ":math:`\bullet` convergence criteria for ustar", "0.00" "atm_data_dir", ":math:`\bullet` directory for atmospheric forcing data", "" "atm_data_format", ":math:`\bullet` format of atmospheric forcing files", "" "atm_data_type", ":math:`\bullet` type of atmospheric forcing", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index fe93cca4c..9d6e6f906 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -332,7 +332,8 @@ Table of namelist options "\*","``calc_strair``", "true", "calculate wind stress and speed", "" "","", "false", "read wind stress and speed from files", "" "\*","``highfreq``", "true/false", "high-frequency atmo coupling", "" - "\*","``natmiter``", "integer", "number of atmo boundary layer iterations", "" + "\*","``natmiter``", "integer", "number of atmo boundary layer iterations", "5" + "\*","``atmiter_conv``", "real", "convergence criteria for ustar", "0.0" "\*","``calc_Tsfc``", "true/false", "calculate surface temperature", "``.true.``" "\*","``default_season``","``winter``", "Sets initial values of forcing and is overwritten if forcing is read in.", "" "\*","``precip_units``", "``mks``", "liquid precipitation data units", "" From e70d1abcbeb4351195a2b81c6ce3f623c936426c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 22 Jun 2020 14:58:13 -0600 Subject: [PATCH 07/44] update icepack submodule --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 1ae044604..2b27a78aa 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 1ae044604498b8d268df6c577556d22d2baa7758 +Subproject commit 2b27a78aaecb3635d14b94464d918a67df750ff0 From 308a1d4f6a1d2e8d9b78f51599eef77a2662feea Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 22 Jun 2020 15:05:32 -0600 Subject: [PATCH 08/44] Revert "update icepack submodule" This reverts commit e70d1abcbeb4351195a2b81c6ce3f623c936426c. --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 2b27a78aa..1ae044604 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 2b27a78aaecb3635d14b94464d918a67df750ff0 +Subproject commit 1ae044604498b8d268df6c577556d22d2baa7758 From 089f60faaa33b66fe878e932b8a20ab81b6f5beb Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 25 Jun 2020 15:18:56 +0000 Subject: [PATCH 09/44] update comp_ice.backend with temporary ice_timers fix --- forapps/ufs/comp_ice.backend.libcice | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/forapps/ufs/comp_ice.backend.libcice b/forapps/ufs/comp_ice.backend.libcice index eb1b8a4e7..ca718548a 100755 --- a/forapps/ufs/comp_ice.backend.libcice +++ b/forapps/ufs/comp_ice.backend.libcice @@ -18,10 +18,10 @@ setenv THRD no # set to yes for OpenMP threading if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -#else if (${SITE} =~ Orion*) then -# setenv ARCH orion_intel -#else if (${SITE} =~ hera*) then -# setenv ARCH hera_intel +else if (${SITE} =~ Orion*) then + setenv ARCH orion_intel +else if (${SITE} =~ hera*) then + setenv ARCH hera_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 @@ -129,6 +129,7 @@ endif mkdir -p ${BINDIR} cp -f ${OBJDIR}/libcice6.a ${BINDIR}/ cp -f ${OBJDIR}/ice_comp_nuopc.mod ${BINDIR}/ +cp -f ${OBJDIR}/ice_timers.mod ${BINDIR}/ cat >! ${BINDIR}/cice6.mk << EOF # ESMF self-describing build dependency makefile fragment From ad03424248118ad304290c30a1454ea591df4f0a Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 1 Jul 2020 12:52:00 -0600 Subject: [PATCH 10/44] Fix threading problem in init_bgc --- cicecore/shared/ice_init_column.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index b41e71aa1..1a4791291 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -865,7 +865,7 @@ subroutine init_bgc() endif ! .not. restart - !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) From 73e77746d8204c181a311be8e51c6b3edec75dea Mon Sep 17 00:00:00 2001 From: David Bailey Date: Wed, 1 Jul 2020 14:41:27 -0600 Subject: [PATCH 11/44] Fix additional OMP problems --- cicecore/shared/ice_init_column.F90 | 8 ++++++-- cicecore/shared/ice_restart_column.F90 | 6 +++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 1a4791291..9e4838087 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -785,7 +785,7 @@ subroutine init_bgc() if (solve_zsal) then ! default values - !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,trcrn_bgc) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -816,6 +816,7 @@ subroutine init_bgc() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -855,6 +856,7 @@ subroutine init_bgc() enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -865,7 +867,7 @@ subroutine init_bgc() endif ! .not. restart - !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -900,6 +902,7 @@ subroutine init_bgc() enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -925,6 +928,7 @@ subroutine init_bgc() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & diff --git a/cicecore/shared/ice_restart_column.F90 b/cicecore/shared/ice_restart_column.F90 index e830dd50b..e819b1098 100644 --- a/cicecore/shared/ice_restart_column.F90 +++ b/cicecore/shared/ice_restart_column.F90 @@ -809,6 +809,7 @@ subroutine read_restart_hbrine() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO end subroutine read_restart_hbrine @@ -868,6 +869,7 @@ subroutine write_restart_hbrine() enddo ! i enddo ! j enddo ! iblk + !$OMP END PARALLEL DO call write_restart_field(nu_dump_hbrine,0,trcrn(:,:,nt_fbri,:,:),'ruf8', & 'fbrn',ncat,diag) @@ -997,6 +999,7 @@ subroutine write_restart_bgc() enddo enddo enddo + !$OMP END PARALLEL DO call write_restart_field(nu_dump_bgc,0,Rayleigh_real,'ruf8','Rayleigh',1,diag) @@ -1411,7 +1414,8 @@ subroutine read_restart_bgc() endif enddo enddo - enddo + enddo ! iblk + !$OMP END PARALLEL DO endif ! restart_zsal !----------------------------------------------------------------- From 46fcfbaaba0161c63c44ecf7f7449df027f97281 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 2 Jul 2020 05:24:54 -0600 Subject: [PATCH 12/44] changes for coldstart running --- .../cicedynB/analysis/ice_history_shared.F90 | 2 - .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 362 +++++++----------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 29 +- 3 files changed, 147 insertions(+), 246 deletions(-) diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index b5f2226fa..ce177ad1e 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -672,9 +672,7 @@ subroutine construct_filename(ncfile,suffix,ns) iday = mday isec = sec - dt -#ifdef CESMCOUPLED if (write_ic) isec = sec -#endif ! construct filename if (write_ic) then write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index e4c2a3802..fca4974b7 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -15,12 +15,6 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet, SetVM -#ifdef CESMCOUPLED - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use shr_const_mod - use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian -#endif use ice_constants , only : ice_init_constants use ice_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use ice_shr_methods , only : set_component_logging, get_component_instance @@ -42,26 +36,20 @@ module ice_comp_nuopc use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist -#if (defined NEWCODE) - use ice_history_shared , only : model_doi_url ! TODO: add this functionality -#endif -#ifdef CESMCOUPLED - use ice_prescribed_mod , only : ice_prescribed_init -#endif -#if (defined NEWCODE) - use ice_atmo , only : flux_convergence_tolerance, flux_convergence_max_iteration - use ice_atmo , only : use_coldair_outbreak_mod -#endif use CICE_InitMod , only : CICE_Init use CICE_RunMod , only : CICE_Run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters + use ice_timers #ifdef CESMCOUPLED + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT + use shr_const_mod + use ice_prescribed_mod , only : ice_prescribed_init use perf_mod , only : t_startf, t_stopf, t_barrierf #endif - use ice_timers implicit none private @@ -75,32 +63,33 @@ module ice_comp_nuopc private :: ModelAdvance private :: ModelSetRunClock private :: ModelFinalize -#ifdef CESMCOUPLED - private :: ice_orbital_init ! only for cesm -#endif + private :: ice_orbital_init ! only valid for cesm character(len=char_len_long) :: flds_scalar_name = '' - integer :: flds_scalar_num = 0 - integer :: flds_scalar_index_nx = 0 - integer :: flds_scalar_index_ny = 0 - integer :: flds_scalar_index_nextsw_cday = 0 + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 character(len=char_len_long) :: orb_mode ! attribute - orbital mode - integer :: orb_iyear ! attribute - orbital year - integer :: orb_iyear_align ! attribute - associated with model year - real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees - real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude - real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity + integer :: orb_iyear ! attribute - orbital year + integer :: orb_iyear_align ! attribute - associated with model year + real(dbl_kind) :: orb_obliq ! attribute - obliquity in degrees + real(dbl_kind) :: orb_mvelp ! attribute - moving vernal equinox longitude + real(dbl_kind) :: orb_eccen ! attribute and update- orbital eccentricity character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' - integer , parameter :: dbug = 10 - integer , parameter :: debug_import = 0 ! internal debug level - integer , parameter :: debug_export = 0 ! internal debug level - character(*), parameter :: modName = "(ice_comp_nuopc)" - character(*), parameter :: u_FILE_u = & + character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' + character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' + + integer , parameter :: dbug = 10 + integer , parameter :: debug_import = 0 ! internal debug level + integer , parameter :: debug_export = 0 ! internal debug level + character(*), parameter :: modName = "(ice_comp_nuopc)" + character(*), parameter :: u_FILE_u = & __FILE__ !======================================================================= @@ -244,8 +233,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) write(logmsg,*) flds_scalar_index_nextsw_cday call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call abort_ice(subname//'Need to set attribute ScalarFieldIdxNextSwCday') endif call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) @@ -265,6 +252,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp type(ESMF_DistGrid) :: distGrid type(ESMF_Mesh) :: Emesh, EmeshTemp integer :: spatialDim @@ -277,7 +265,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer , allocatable :: gindex(:) integer :: globalID character(ESMF_MAXSTR) :: cvalue - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len) :: tfrz_option character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_VM) :: vm @@ -356,9 +343,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! start cice timers !---------------------------------------------------------------------------- -#ifdef CESMCOUPLED call t_startf ('cice_init_total') -#endif !---------------------------------------------------------------------------- ! Initialize constants @@ -403,44 +388,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- ! Get orbital values - ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 - ! if CESMCOUPLED is not defined -#ifdef CESMCOUPLED call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#else - ! Start with icepack values then update with values defined in configure file if they exist - call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) eccen - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) obliqr - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) lambm0 - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) mvelpp - end if - - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif ! Determine runtype and possibly nextsw_cday call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, isPresent=isPresent, rc=rc) @@ -473,22 +422,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else - ! This would be the NEMS branch - ! Note that in NEMS - nextsw_cday is not needed in ice_orbital.F90 and what is needed is - ! simply a CPP variable declaratino of NEMSCOUPLED - runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if single_column = .false. -#ifdef CESMCOUPLED - ! Determine single column info - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) single_column - end if -#endif + ! Determine single column info - only valid for cesm + !call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (isPresent) then + ! read(cvalue,*) single_column + !end if + if (single_column) then ! Must have these attributes present call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) @@ -507,46 +451,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined end if -#ifdef CESMCOUPLED - ! Determine tfreeze_option, flux convertence before call to cice_init - ! tcx, what is going on here? if not present, set it? if present, ignore it? - call NUOPC_CompAttributeGet(gcomp, name="tfreeze_option", value=tfrz_option, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. isPresent) then - tfrz_option = 'linear_salt' ! TODO: is this right? This must be the same as mom is using for the calculation. - end if - call icepack_init_parameters(tfrz_option_in=tfrz_option) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif - -#if (defined NEWCODE) - call NUOPC_CompAttributeGet(gcomp, name="flux_convergence", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) flux_convergence_tolerance - else - flux_convergence_tolerance = 0._dbl_kind - end if - - call NUOPC_CompAttributeGet(gcomp, name="flux_max_iteration", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) flux_convergence_max_iteration - else - flux_convergence_max_iteration = 5 - end if - - call NUOPC_CompAttributeGet(gcomp, name="coldair_outbreak_mod", value=cvalue, isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) use_coldair_outbreak_mod - else - use_coldair_outbreak_mod = .false. - end if -#endif - ! Get clock information before call to cice_init call ESMF_ClockGet( clock, & @@ -576,8 +480,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar_type = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then @@ -585,7 +487,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if -#endif !---------------------------------------------------------------------------- ! Set cice logging @@ -594,15 +495,16 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the nu_diag_set flag so it's not reset later #ifdef CESMCOUPLED - call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + open(newunit=nu_diag, file=trim(diro)//"/"//trim(logfile)) + end if nu_diag_set = .true. #endif -#ifdef CESMCOUPLED - call shr_file_setLogUnit (shrlogunit) -#endif - !---------------------------------------------------------------------------- ! Initialize cice !---------------------------------------------------------------------------- @@ -610,13 +512,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that cice_init also sets time manager info as well as mpi communicator info, ! including master_task and my_task -#ifdef CESMCOUPLED call t_startf ('cice_init') -#endif call cice_init( lmpicom ) -#ifdef CESMCOUPLED call t_stopf ('cice_init') -#endif !---------------------------------------------------------------------------- ! reset shr logging to my log file @@ -637,10 +535,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' inst_name = ',trim(inst_name) write(nu_diag,*) trim(subname),' inst_index = ',inst_index write(nu_diag,*) trim(subname),' inst_suffix = ',trim(inst_suffix) -#if (defined NEWCODE) - write(nu_diag,*) trim(subname),' flux_convergence = ', flux_convergence_tolerance - write(nu_diag,*) trim(subname),' flux_convergence_max_iteration = ', flux_convergence_max_iteration -#endif endif !--------------------------------------------------------------------------- @@ -968,25 +862,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - call ESMF_AttributeAdd(comp, convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ShortName", "CICE", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", "CICE Model", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Description", "CICE5", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "Name", "David Bailey", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "EmailAddress", "dbailey@ucar.edu", convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) -#endif - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) -#ifdef CESMCOUPLED call t_stopf ('cice_init_total') -#endif deallocate(gindex_ice) deallocate(gindex) @@ -1030,7 +908,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: tod_sync ! Sync current time of day (sec) character(char_len_long) :: restart_date character(char_len_long) :: restart_filename - logical :: isPresent + logical :: isPresent, isSet character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !-------------------------------- @@ -1043,19 +921,15 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call ice_timer_start(timer_total) ! time entire run -#ifdef CESMCOUPLED call t_barrierf('cice_run_total_BARRIER',mpi_comm_ice) call t_startf ('cice_run_total') -#endif !-------------------------------- ! Reset shr logging to my log file !-------------------------------- -#ifdef CESMCOUPLED call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (nu_diag) -#endif !-------------------------------- ! Query the Component for its clock, importState and exportState @@ -1068,10 +942,18 @@ subroutine ModelAdvance(gcomp, rc) ! Determine time of next atmospheric shortwave calculation !-------------------------------- - call State_GetScalar(importState, flds_scalar_index_nextsw_cday, nextsw_cday, & - flds_scalar_name, flds_scalar_num, rc) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (isPresent .and. isSet) then + call State_GetScalar(importState, flds_scalar_index_nextsw_cday, nextsw_cday, & + flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (my_task == master_task) then write(nu_diag,F00) trim(subname),' cice istep, nextsw_cday = ',istep, nextsw_cday end if @@ -1079,44 +961,8 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! Obtain orbital values !-------------------------------- -#ifdef CESMCOUPLED call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#else - ! Start with icepack values then update with values defined in configure file if they exist - ! tcx, This should be identical with initialization, why do it again? Get rid of it - call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) eccen - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) obliqr - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) lambm0 - end if - call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - read(cvalue,*) mvelpp - end if - - call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, & - lambm0_in=lambm0, obliqr_in=obliqr) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif !-------------------------------- ! check that cice internal time is in sync with master clock before timestep update @@ -1175,19 +1021,11 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- -#ifdef CESMCOUPLED call t_barrierf('cice_run_import_BARRIER',mpi_comm_ice) call t_startf ('cice_run_import') - call ice_timer_start(timer_cplrecv) -#endif - call ice_import(importState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED - call ice_timer_stop(timer_cplrecv) call t_stopf ('cice_run_import') -#endif ! write Debug output if (debug_import > 0 .and. my_task==master_task) then @@ -1200,29 +1038,17 @@ subroutine ModelAdvance(gcomp, rc) ! Advance cice and timestep update !-------------------------------- -!tcraig if (force_restart_now) then -! call CICE_Run(restart_filename=restart_filename) -! else - call CICE_Run() -! end if + call CICE_Run() !-------------------------------- ! Create export state !-------------------------------- -#ifdef CESMCOUPLED call t_barrierf('cice_run_export_BARRIER',mpi_comm_ice) call t_startf ('cice_run_export') - call ice_timer_start(timer_cplsend) -#endif - call ice_export(exportState, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - -#ifdef CESMCOUPLED - call ice_timer_stop(timer_cplsend) call t_stopf ('cice_run_export') -#endif if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & @@ -1230,10 +1056,8 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#ifdef CESMCOUPLED ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) -#endif !-------------------------------- ! stop timers and print timer info @@ -1257,9 +1081,7 @@ subroutine ModelAdvance(gcomp, rc) stop_now = .false. endif -#ifdef CESMCOUPLED call t_stopf ('cice_run_total') -#endif ! Need to stop this at the end of every run phase in a coupled run. call ice_timer_stop(timer_total) @@ -1333,7 +1155,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(subname//'setting alarms for ' // trim(name), ESMF_LOGMSG_INFO) !---------------- ! Restart alarm @@ -1564,8 +1386,64 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) file=__FILE__, line=__LINE__) first_time = .false. + end subroutine ice_orbital_init + +#else + + subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) + + ! dummy input/output arguments + type(ESMF_GridComp) :: gcomp + type(ESMF_Clock) , intent(in) :: clock + integer , intent(in) :: logunit + logical , intent(in) :: mastertask + integer , intent(out) :: rc ! output error + + ! local variables + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + logical :: isPresent, isSet + character(ESMF_MAXSTR) :: cvalue + logical :: first_time = .true. + character(len=*) , parameter :: subname = "(cice_orbital_init)" + !-------------------------------- + + rc = ESMF_SUCCESS + + if (first_time) then + ! Start with icepack values then update with values defined in configure file if they exist + ! tcx, This should be identical with initialization, why do it again? Get rid of it + call icepack_query_orbit(eccen_out=eccen, mvelpp_out=mvelpp, lambm0_out=lambm0, obliqr_out=obliqr) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) eccen + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) obliqr + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) lambm0 + ! end if + ! call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) + ! if (isPresent) then + ! read(cvalue,*) mvelpp + ! end if + + ! call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) + ! call icepack_warnings_flush(nu_diag) + ! if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + ! file=__FILE__, line=__LINE__) + + first_time = .false. + end if end subroutine ice_orbital_init + #endif !=============================================================================== @@ -1593,4 +1471,28 @@ end subroutine ice_cal_ymd2date !=============================================================================== +#ifndef CESMCOUPLED + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit + + subroutine t_startf(string) + character(len=*) :: string + end subroutine t_startf + subroutine t_stopf(string) + character(len=*) :: string + end subroutine t_stopf + subroutine t_barrierf(string, comm) + character(len=*) :: string + integer:: comm + end subroutine t_barrierf +#endif + end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 083283895..4cceaa9ca 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -190,19 +190,19 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, trim(flds_scalar_name)) ! ice states - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_mask' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'sea_ice_temperature' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_ice_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_snow_volume' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_mask' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'sea_ice_surface_temperature' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_ice_volume' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_snow_volume' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dir_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) #if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & @@ -908,7 +908,8 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) + !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! albedo vis dir From c76233609c7e90d77618bf54fbf65e50604d851b Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 2 Jul 2020 11:36:49 -0600 Subject: [PATCH 13/44] Move the forapps directory --- .../scripts/forapps}/ufs/comp_ice.backend.clean | 0 .../scripts/forapps}/ufs/comp_ice.backend.libcice | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {forapps => configuration/scripts/forapps}/ufs/comp_ice.backend.clean (100%) rename {forapps => configuration/scripts/forapps}/ufs/comp_ice.backend.libcice (100%) diff --git a/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean similarity index 100% rename from forapps/ufs/comp_ice.backend.clean rename to configuration/scripts/forapps/ufs/comp_ice.backend.clean diff --git a/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice similarity index 100% rename from forapps/ufs/comp_ice.backend.libcice rename to configuration/scripts/forapps/ufs/comp_ice.backend.libcice From 6bccf71a499b0fa558e75d44c79159ac988f6b3c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 2 Jul 2020 13:19:25 -0600 Subject: [PATCH 14/44] remove cesmcoupled ifdefs --- .../infrastructure/ice_read_write.F90 | 30 ++++++++++++------- .../infrastructure/ice_restart_driver.F90 | 8 ----- .../io/io_netcdf/ice_restart.F90 | 3 -- 3 files changed, 19 insertions(+), 22 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index f497db49b..4fa115ee3 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1106,6 +1106,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines +! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! dimension size @@ -1113,7 +1114,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & @@ -1279,6 +1280,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & n, & ! ncat index varid , & ! variable id status ! status output from netcdf routines +! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1286,7 +1288,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & @@ -1364,7 +1366,7 @@ 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, & +! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & ! ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar @@ -1835,6 +1837,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1844,7 +1847,8 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! lvarname, & ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1955,16 +1959,18 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: & n, & ! ncat index status ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension +! status, & ! status output from netcdf routines +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & lvarname ! variable name -! dimname ! dimension name +! lvarname, & ! variable name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2081,6 +2087,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind) :: & varid, & ! netcdf id for field status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2088,9 +2095,9 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name -! + #ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2232,6 +2239,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines +! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2239,7 +2247,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index d3829b9c4..25bb6f5f8 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -58,9 +58,7 @@ subroutine dumpfile(filename_spec) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_state, only: aicen, vicen, vsnon, trcrn, uvel, vvel character(len=char_len_long), intent(in), optional :: filename_spec @@ -132,9 +130,7 @@ subroutine dumpfile(filename_spec) !----------------------------------------------------------------- ! radiation fields !----------------------------------------------------------------- -#ifdef CESMCOUPLED call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) -#endif call write_restart_field(nu_dump,0,scale_factor,'ruf8','scale_factor',1,diag) call write_restart_field(nu_dump,0,swvdr,'ruf8','swvdr',1,diag) @@ -209,9 +205,7 @@ subroutine restartfile (ice_ic) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_grid, only: tmask, grid_type use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -310,11 +304,9 @@ subroutine restartfile (ice_ic) if (my_task == master_task) & write(nu_diag,*) 'radiation fields' -#ifdef CESMCOUPLED call read_restart_field(nu_restart,0,coszen,'ruf8', & ! 'coszen',1,diag, field_loc_center, field_type_scalar) 'coszen',1,diag) -#endif call read_restart_field(nu_restart,0,scale_factor,'ruf8', & 'scale_factor',1,diag, field_loc_center, field_type_scalar) call read_restart_field(nu_restart,0,swvdr,'ruf8', & diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index d4decf6f7..214fc356b 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -84,7 +84,6 @@ subroutine init_restart_read(ice_ic) endif endif ! use namelist values if use_restart_time = F - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc endif call broadcast_scalar(istep0,master_task) @@ -228,9 +227,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'uvel',dims) call define_rest_field(ncid,'vvel',dims) -#ifdef CESMCOUPLED call define_rest_field(ncid,'coszen',dims) -#endif call define_rest_field(ncid,'scale_factor',dims) call define_rest_field(ncid,'swvdr',dims) call define_rest_field(ncid,'swvdf',dims) From 902e8833b3c8c40f0d12fd81b38eb792ca739f0e Mon Sep 17 00:00:00 2001 From: David Bailey Date: Thu, 2 Jul 2020 15:27:55 -0600 Subject: [PATCH 15/44] Fix logging issues for NUOPC --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 8 ++------ cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 16 +++++++++++----- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 16e4216e6..3dcd8fb2f 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -57,7 +57,7 @@ end subroutine CICE_Initialize ! ! Initialize CICE model. - subroutine cice_init(mpicom_ice) + subroutine cice_init use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column use ice_arrays_column, only: floe_rad_l, floe_rad_c, & @@ -66,7 +66,7 @@ subroutine cice_init(mpicom_ice) use ice_flux_bgc, only: alloc_flux_bgc use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & init_calendar, calendar - use ice_communicate, only: init_communicate, my_task, master_task + use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd @@ -91,14 +91,10 @@ subroutine cice_init(mpicom_ice) use drv_forcing, only: sst_sss #endif - integer (kind=int_kind), optional, intent(in) :: & - mpicom_ice ! communicator for sequential ccsm - logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' - call init_communicate(mpicom_ice) ! initial setup for message passing call init_fileunits ! unit numbers call icepack_configure() ! initialize icepack diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index e4c2a3802..81fb1a308 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -62,6 +62,7 @@ module ice_comp_nuopc use perf_mod , only : t_startf, t_stopf, t_barrierf #endif use ice_timers + use ice_communicate, only: init_communicate implicit none private @@ -328,6 +329,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer(int_kind) :: ktherm character(*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + logical :: mastertask !-------------------------------- rc = ESMF_SUCCESS @@ -406,7 +408,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that these values are obtained in a call to init_orbit in ice_shortwave.F90 ! if CESMCOUPLED is not defined #ifdef CESMCOUPLED - call ice_orbital_init(gcomp, clock, nu_diag, my_task==master_task, rc) + mastertask = .false. + if (my_task == master_task) mastertask = .true. + call ice_orbital_init(gcomp, clock, nu_diag, mastertask, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return #else ! Start with icepack values then update with values defined in configure file if they exist @@ -593,11 +597,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later -#ifdef CESMCOUPLED - call set_component_logging(gcomp, my_task==master_task, nu_diag, shrlogunit, rc) + call init_communicate(lmpicom) ! initial setup for message passing + + mastertask = .false. + if (my_task == master_task) mastertask = .true. + call set_component_logging(gcomp, mastertask, nu_diag, shrlogunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nu_diag_set = .true. -#endif #ifdef CESMCOUPLED call shr_file_setLogUnit (shrlogunit) @@ -613,7 +619,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) #ifdef CESMCOUPLED call t_startf ('cice_init') #endif - call cice_init( lmpicom ) + call cice_init #ifdef CESMCOUPLED call t_stopf ('cice_init') #endif From b4afd2e55df3a66db133775f6ceb7bd412317fab Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Jul 2020 11:59:19 -0600 Subject: [PATCH 16/44] removal of many cpp-ifdefs --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 84 ++--- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 50 +-- .../drivers/nuopc/cmeps/cice_wrapper_mod.F90 | 36 +++ .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 287 ++++++++---------- .../drivers/nuopc/cmeps/ice_import_export.F90 | 97 +++--- .../nuopc/cmeps/ice_prescribed_mod.F90 | 11 + 6 files changed, 249 insertions(+), 316 deletions(-) create mode 100644 cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 16e4216e6..2ae6f87fe 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -25,40 +25,21 @@ module CICE_InitMod implicit none private - public :: CICE_Initialize, cice_init + public :: cice_init !======================================================================= contains -!======================================================================= - -! Initialize the basic state, grid and all necessary parameters for -! running the CICE model. Return the initial state in routine -! export state. -! Note: This initialization driver is designed for standalone and -! CESM-coupled applications. For other -! applications (e.g., standalone CAM), this driver would be -! replaced by a different driver that calls subroutine cice_init, -! where most of the work is done. - - subroutine CICE_Initialize - - character(len=*), parameter :: subname='(CICE_Initialize)' - !-------------------------------------------------------------------- - ! model initialization - !-------------------------------------------------------------------- - - call cice_init - - end subroutine CICE_Initialize - !======================================================================= ! ! Initialize CICE model. subroutine cice_init(mpicom_ice) + ! Initialize the basic state, grid and all necessary parameters for + ! running the CICE model. + use ice_arrays_column, only: hin_max, c_hi_range, alloc_arrays_column use ice_arrays_column, only: floe_rad_l, floe_rad_c, & floe_binwidth, c_fsd_range @@ -66,7 +47,7 @@ subroutine cice_init(mpicom_ice) use ice_flux_bgc, only: alloc_flux_bgc use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & init_calendar, calendar - use ice_communicate, only: init_communicate, my_task, master_task + use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd @@ -74,8 +55,7 @@ subroutine cice_init(mpicom_ice) use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared 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 + use ice_forcing, only: init_forcing_ocn 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 @@ -87,9 +67,6 @@ subroutine cice_init(mpicom_ice) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpicom_ice ! communicator for sequential ccsm @@ -98,7 +75,6 @@ subroutine cice_init(mpicom_ice) tr_iso, tr_fsd, wave_spec character(len=*), parameter :: subname = '(cice_init)' - call init_communicate(mpicom_ice) ! initial setup for message passing call init_fileunits ! unit numbers call icepack_configure() ! initialize icepack @@ -133,10 +109,6 @@ subroutine cice_init(mpicom_ice) endif call init_coupler_flux ! initialize fluxes exchanged with coupler - -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -162,7 +134,9 @@ subroutine cice_init(mpicom_ice) call calendar(time) ! determine the initial date + ! TODO: - why is this being called when you are using CMEPS? call init_forcing_ocn(dt) ! initialize sss and sst from data + call init_state ! initialize the ice state call init_transport ! initialize horizontal transport call ice_HaloRestore_init ! restored boundary conditions @@ -186,51 +160,31 @@ subroutine cice_init(mpicom_ice) if (icepack_warnings_aborted()) call abort_ice(trim(subname), & file=__FILE__,line= __LINE__) - if (tr_aero .or. tr_zaero) call faero_optics !initialize aerosol optical - !property tables + if (tr_aero .or. tr_zaero) then + call faero_optics !initialize aerosol optical property tables + end if ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. - if (trim(runtype) == 'continue' .or. restart) & - call init_shortwave ! initialize radiative transfer - -! istep = istep + 1 ! update time step counters -! istep1 = istep1 + 1 -! time = time + dt ! determine the time and date -! call calendar(time) ! at the end of the first timestep - !-------------------------------------------------------------------- - ! coupler communication or forcing data initialization - !-------------------------------------------------------------------- - -#ifndef coupled - call init_forcing_atmo ! initialize atmospheric forcing (standalone) + if (trim(runtype) == 'continue' .or. restart) then + call init_shortwave ! initialize radiative transfer + end if -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data + !-------------------------------------------------------------------- + ! coupler communication or forcing data initialization + !-------------------------------------------------------------------- - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry - if (runtype == 'initial' .and. .not. restart) & + if (runtype == 'initial' .and. .not. restart) then call init_shortwave ! initialize radiative transfer using current swdn + end if call init_flux_atm ! initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler -! if (write_ic) call accum_hist(dt) ! write initial conditions - end subroutine cice_init !======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index aed00a9a0..486c36dcc 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -15,9 +15,7 @@ module CICE_RunMod use ice_kinds_mod -#ifdef CESMCOUPLED - use perf_mod, only : t_startf, t_stopf, t_barrierf -#endif + use cice_wrapper_mod, only : t_startf, t_stopf, t_barrierf use ice_fileunits, only: nu_diag use ice_arrays_column, only: oceanmixed_ice use ice_constants, only: c0, c1 @@ -79,48 +77,22 @@ subroutine CICE_Run ! timestep loop !-------------------------------------------------------------------- -! timeLoop: do - -! call ice_step - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - -! call calendar(time) ! at the end of the timestep + istep = istep + 1 ! update time step counters + istep1 = istep1 + 1 + time = time + dt ! determine the time and date - call ice_timer_start(timer_couple) ! atm/ocn coupling - -#ifndef coupled -#ifndef CESMCOUPLED -! for now, wave_spectrum is constant in time -! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif - if (z_tracers) call get_atm_bgc ! biogeochemistry + call ice_timer_start(timer_couple) ! atm/ocn coupling - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler + if (z_tracers) call get_atm_bgc ! biogeochemistry - call calendar(time) ! at the end of the timestep + call init_flux_atm ! Initialize atmosphere fluxes sent to coupler + call init_flux_ocn ! initialize ocean fluxes sent to coupler - call ice_timer_stop(timer_couple) ! atm/ocn coupling + call calendar(time) ! at the end of the timestep - call ice_step + call ice_timer_stop(timer_couple) ! atm/ocn coupling -! if (stop_now >= 1) exit timeLoop -! enddo timeLoop + call ice_step !-------------------------------------------------------------------- ! end of timestep loop diff --git a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 new file mode 100644 index 000000000..e350e9a52 --- /dev/null +++ b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 @@ -0,0 +1,36 @@ +module cice_wrapper_mod + +#ifdef CESMCOUPLED + use perf_mod, only : t_startf, t_stopf, t_barrierf +#endif + + +contains + +#ifndef CESMCOUPLED + ! These are just stub routines put in place to remove + + subroutine shr_file_setLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_setLogUnit + subroutine shr_file_getLogUnit(nunit) + integer, intent(in) :: nunit + ! do nothing for this stub - its just here to replace + ! having cppdefs in the main program + end subroutine shr_file_getLogUnit + + subroutine t_startf(string) + character(len=*) :: string + end subroutine t_startf + subroutine t_stopf(string) + character(len=*) :: string + end subroutine t_stopf + subroutine t_barrierf(string, comm) + character(len=*) :: string + integer:: comm + end subroutine t_barrierf +#endif + +end module cice_wrapper_mod diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index fca4974b7..c3947cb98 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -27,7 +27,7 @@ module ice_comp_nuopc use ice_blocks , only : nblocks_tot, get_block_parameter use ice_distribution , only : ice_distributiongetblockloc use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT - use ice_communicate , only : my_task, master_task, mpi_comm_ice + use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep @@ -36,19 +36,19 @@ module ice_comp_nuopc use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name, inst_suffix, release_all_fileunits, flush_fileunit use ice_restart_shared , only : runid, runtype, restart_dir, restart_file use ice_history , only : accum_hist - use CICE_InitMod , only : CICE_Init - use CICE_RunMod , only : CICE_Run + use CICE_InitMod , only : cice_init + use CICE_RunMod , only : cice_run use ice_exit , only : abort_ice use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_init_orbit, icepack_init_parameters, icepack_query_orbit use icepack_intfc , only : icepack_query_tracer_flags, icepack_query_parameters use ice_timers + use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod , only : shr_file_getlogunit, shr_file_setlogunit #ifdef CESMCOUPLED - use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit - use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_const_mod + use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use ice_prescribed_mod , only : ice_prescribed_init - use perf_mod , only : t_startf, t_stopf, t_barrierf #endif implicit none @@ -179,7 +179,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Local variables character(len=char_len_long) :: cvalue character(len=char_len_long) :: logmsg - logical :: isPresent, isSet + logical :: isPresent, isSet character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !-------------------------------- @@ -252,69 +252,69 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! Local variables - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - type(ESMF_DistGrid) :: distGrid - type(ESMF_Mesh) :: Emesh, EmeshTemp - integer :: spatialDim - integer :: numOwnedElements - real(dbl_kind), pointer :: ownedElemCoords(:) - real(dbl_kind), pointer :: lat(:), latMesh(:) - real(dbl_kind), pointer :: lon(:), lonMesh(:) - integer , allocatable :: gindex_ice(:) - integer , allocatable :: gindex_elim(:) - integer , allocatable :: gindex(:) - integer :: globalID - character(ESMF_MAXSTR) :: cvalue - character(len=char_len) :: tfrz_option - character(ESMF_MAXSTR) :: convCIM, purpComp - type(ESMF_VM) :: vm - type(ESMF_Time) :: currTime ! Current time - type(ESMF_Time) :: startTime ! Start time - type(ESMF_Time) :: stopTime ! Stop time - type(ESMF_Time) :: refTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer :: start_ymd ! Start date (YYYYMMDD) - integer :: start_tod ! start time of day (s) - integer :: curr_ymd ! Current date (YYYYMMDD) - integer :: curr_tod ! Current time of day (s) - integer :: stop_ymd ! stop date (YYYYMMDD) - integer :: stop_tod ! stop time of day (sec) - integer :: ref_ymd ! Reference date (YYYYMMDD) - integer :: ref_tod ! reference time of day (s) - integer :: yy,mm,dd ! Temporaries for time query - integer :: iyear ! yyyy - integer :: dtime ! time step - integer :: lmpicom - integer :: shrlogunit ! original log unit - character(len=char_len) :: starttype ! infodata start type - integer :: lsize ! local size of coupling array - character(len=512) :: diro - character(len=512) :: logfile - logical :: isPresent - integer :: localPet - integer :: n,c,g,i,j,m ! indices - integer :: iblk, jblk ! indices - integer :: ig, jg ! indices - integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain - type(block) :: this_block ! block information for current block - integer :: compid ! component id + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + type(ESMF_DistGrid) :: distGrid + type(ESMF_Mesh) :: Emesh, EmeshTemp + integer :: spatialDim + integer :: numOwnedElements + real(dbl_kind), pointer :: ownedElemCoords(:) + real(dbl_kind), pointer :: lat(:), latMesh(:) + real(dbl_kind), pointer :: lon(:), lonMesh(:) + integer , allocatable :: gindex_ice(:) + integer , allocatable :: gindex_elim(:) + integer , allocatable :: gindex(:) + integer :: globalID + character(ESMF_MAXSTR) :: cvalue + character(len=char_len) :: tfrz_option + character(ESMF_MAXSTR) :: convCIM, purpComp + type(ESMF_VM) :: vm + type(ESMF_Time) :: currTime ! Current time + type(ESMF_Time) :: startTime ! Start time + type(ESMF_Time) :: stopTime ! Stop time + type(ESMF_Time) :: refTime ! Ref time + type(ESMF_TimeInterval) :: timeStep ! Model timestep + type(ESMF_Calendar) :: esmf_calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! start time of day (s) + integer :: curr_ymd ! Current date (YYYYMMDD) + integer :: curr_tod ! Current time of day (s) + integer :: stop_ymd ! stop date (YYYYMMDD) + integer :: stop_tod ! stop time of day (sec) + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! reference time of day (s) + integer :: yy,mm,dd ! Temporaries for time query + integer :: iyear ! yyyy + integer :: dtime ! time step + integer :: lmpicom + integer :: shrlogunit ! original log unit + character(len=char_len) :: starttype ! infodata start type + integer :: lsize ! local size of coupling array + logical :: isPresent + logical :: isSet + integer :: localPet + integer :: n,c,g,i,j,m ! indices + integer :: iblk, jblk ! indices + integer :: ig, jg ! indices + integer :: ilo, ihi, jlo, jhi ! beginning and end of physical domain + type(block) :: this_block ! block information for current block + integer :: compid ! component id character(len=char_len_long) :: tempc1,tempc2 - real(dbl_kind) :: diff_lon - integer :: npes - integer :: num_elim_global - integer :: num_elim_local - integer :: num_elim - integer :: num_ice - integer :: num_elim_gcells ! local number of eliminated gridcells - integer :: num_elim_blocks ! local number of eliminated blocks - integer :: num_total_blocks - integer :: my_elim_start, my_elim_end - real(dbl_kind) :: rad_to_deg - integer(int_kind) :: ktherm - character(*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" - character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' + real(dbl_kind) :: diff_lon + integer :: npes + integer :: num_elim_global + integer :: num_elim_local + integer :: num_elim + integer :: num_ice + integer :: num_elim_gcells ! local number of eliminated gridcells + integer :: num_elim_blocks ! local number of eliminated blocks + integer :: num_total_blocks + integer :: my_elim_start, my_elim_end + real(dbl_kind) :: rad_to_deg + integer(int_kind) :: ktherm + character(len=char_len_long) :: diag_filename = 'unset' + character(len=*), parameter :: F00 = "('(ice_comp_nuopc) ',2a,1x,d21.14)" + character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' !-------------------------------- rc = ESMF_SUCCESS @@ -378,6 +378,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) pi_in = SHR_CONST_PI, & snowpatch_in = 0.005_dbl_kind, & dragio_in = 0.00962_dbl_kind) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -406,12 +407,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice( subname//' ERROR: unknown starttype' ) end if - ! Note that in the mct version the atm was initialized first so that nextsw_cday could be passed to the other - ! components - this assumed that cam or datm was ALWAYS initialized first. - ! In the nuopc version it will be easier to assume that on startup - nextsw_cday is just the current time - + ! We assume here that on startup - nextsw_cday is just the current time ! TOOD (mvertens, 2019-03-21): need to get the perpetual run working - if (trim(runtype) /= 'initial') then ! Set nextsw_cday to -1 (this will skip an orbital calculation on initialization nextsw_cday = -1.0_dbl_kind @@ -425,34 +422,33 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = 'initial' ! determined from the namelist in ice_init if CESMCOUPLED is not defined end if - single_column = .false. - ! Determine single column info - only valid for cesm - !call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !if (isPresent) then - ! read(cvalue,*) single_column - !end if - - if (single_column) then - ! Must have these attributes present - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat + ! Determine if single column + call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) single_column + if (single_column) then + call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + end if + else + single_column = .false. end if ! Determine runid - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, rc=rc) - if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (isPresent .and. isSet) then read(cvalue,*) runid else - runid = 'unknown' ! read in from the namelist in ice_init.F90 if CESMCOUPLED is not defined + ! read in from the namelist in ice_init.F90 if this is not an attribute passed from the driver + runid = 'unknown' end if ! Get clock information before call to cice_init - call ESMF_ClockGet( clock, & currTime=currTime, startTime=startTime, stopTime=stopTime, refTime=RefTime, & timeStep=timeStep, rc=rc) @@ -488,22 +484,35 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice( subname//'ERROR:: bad calendar for ESMF' ) end if + !---------------------------------------------------------------------------- + ! Initialize cice communicators + !---------------------------------------------------------------------------- + + call init_communicate(lmpicom) ! initial setup for message passing + !---------------------------------------------------------------------------- ! Set cice logging !---------------------------------------------------------------------------- + ! Note - this must be done AFTER the communicators are set ! Note that sets the nu_diag module variable in ice_fileunits ! Set the nu_diag_set flag so it's not reset later -#ifdef CESMCOUPLED if (my_task == master_task) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (isPresent .and. isSet) then + diag_filename = trim(cvalue) + end if + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - open(newunit=nu_diag, file=trim(diro)//"/"//trim(logfile)) + if (isPresent .and. isSet) then + diag_filename = trim(diag_filename) // '/' // trim(cvalue) + end if + if (trim(diag_filename) /= 'unset') then + open(newunit=nu_diag, file=trim(diag_filename)) + nu_diag_set = .true. + end if end if - nu_diag_set = .true. -#endif !---------------------------------------------------------------------------- ! Initialize cice @@ -513,7 +522,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! including master_task and my_task call t_startf ('cice_init') - call cice_init( lmpicom ) + call cice_init() call t_stopf ('cice_init') !---------------------------------------------------------------------------- @@ -819,18 +828,18 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#ifdef CESMCOUPLED !----------------------------------------------------------------- ! Prescribed ice initialization - first get compid !----------------------------------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) compid ! convert from string to integer - - ! Having this if-defd means that MCT does not need to be build in a NEMS configuration + if (isPresent and isSet) then + read(cvalue,*) compid ! convert from string to integer + else + compid = 0 + end if call ice_prescribed_init(lmpicom, compid, gindex_ice) -#endif !----------------------------------------------------------------- ! Create cice export state @@ -847,7 +856,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! TODO (mvertens, 2018-12-21): fill in iceberg_prognostic as .false. - if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & idate, sec, nu_diag, rc=rc) @@ -1267,14 +1275,14 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) integer , intent(out) :: rc ! output error ! local variables - real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp + real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp character(len=char_len_long) :: msgstr ! temporary character(len=char_len_long) :: cvalue ! temporary - type(ESMF_Time) :: CurrTime ! current time - integer :: year ! model year at current time - integer :: orb_year ! orbital year for current orbital computation - logical :: lprint - logical :: first_time = .true. + type(ESMF_Time) :: CurrTime ! current time + integer :: year ! model year at current time + integer :: orb_year ! orbital year for current orbital computation + logical :: lprint + logical :: first_time = .true. character(len=*) , parameter :: subname = "(cice_orbital_init)" !------------------------------------------------------------------------------- @@ -1388,7 +1396,7 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) first_time = .false. end subroutine ice_orbital_init -#else +#else subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) @@ -1401,12 +1409,10 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) ! local variables real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp - logical :: isPresent, isSet - character(ESMF_MAXSTR) :: cvalue logical :: first_time = .true. character(len=*) , parameter :: subname = "(cice_orbital_init)" !-------------------------------- - + rc = ESMF_SUCCESS if (first_time) then @@ -1417,28 +1423,6 @@ subroutine ice_orbital_init(gcomp, clock, logunit, mastertask, rc) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - ! call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) eccen - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) obliqr - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) lambm0 - ! end if - ! call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, isPresent=isPresent, rc=rc) - ! if (isPresent) then - ! read(cvalue,*) mvelpp - ! end if - - ! call icepack_init_orbit(eccen_in=eccen, mvelpp_in=mvelpp, lambm0_in=lambm0, obliqr_in=obliqr) - ! call icepack_warnings_flush(nu_diag) - ! if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - ! file=__FILE__, line=__LINE__) - first_time = .false. end if @@ -1471,28 +1455,5 @@ end subroutine ice_cal_ymd2date !=============================================================================== -#ifndef CESMCOUPLED - subroutine shr_file_setLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_setLogUnit - subroutine shr_file_getLogUnit(nunit) - integer, intent(in) :: nunit - ! do nothing for this stub - its just here to replace - ! having cppdefs in the main program - end subroutine shr_file_getLogUnit - - subroutine t_startf(string) - character(len=*) :: string - end subroutine t_startf - subroutine t_stopf(string) - character(len=*) :: string - end subroutine t_stopf - subroutine t_barrierf(string, comm) - character(len=*) :: string - integer:: comm - end subroutine t_barrierf -#endif end module ice_comp_nuopc diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 4cceaa9ca..da022ddcf 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -35,9 +35,9 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature + use ice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp - use perf_mod , only : t_startf, t_stopf, t_barrierf #endif implicit none @@ -105,30 +105,35 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam integer , intent(out) :: rc ! local variables - integer :: n + integer :: n character(char_len) :: stdname character(char_len) :: cvalue - logical :: flds_wiso ! use case - logical :: flds_i2o_per_cat ! .true. => select per ice thickness category + logical :: flds_wiso ! use case + logical :: flds_i2o_per_cat ! .true. => select per ice thickness category + logical :: isPresent, isSet character(len=*), parameter :: subname='(ice_import_export:ice_advertise_fields)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. - flds_i2o_per_cat = .false. -#ifdef CESMCOUPLED - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_wiso - call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) + if (isPresent .and. isSet) then + read(cvalue,*) flds_wiso + call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if + #if (defined NEWCODE) - call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + flds_i2o_per_cat = .false. + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) send_i2x_per_cat - call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) -#endif + if (isPresent .and. isSet) then + read(cvalue,*) send_i2x_per_cat + call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) + end if #endif !----------------- @@ -166,16 +171,14 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm -#ifdef CESMCOUPLED + ! the folloing are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) - ! from atm - wet dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) - ! from - atm dry dust deposition frluxes (4 sizes) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) -#endif do n = 1,fldsToIce_num call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & @@ -203,7 +206,10 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dir_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) + #if (defined NEWCODE) + ! the following are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & ungridded_lbound=1, ungridded_ubound=ncat) @@ -226,6 +232,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_vis_dif_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dir_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dif_flx' ) + #if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ifrac_n', & @@ -236,11 +243,13 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_merid' ) -#ifdef CESMCOUPLED + + ! the following are advertised but might not be connected if they are not present + ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcpho' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_bcphi' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'Fioi_flxdst' ) -#endif + if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) @@ -446,13 +455,9 @@ subroutine ice_import( importState, rc ) ! perform a halo update if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') -#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_scalar) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') -#endif endif ! now fill in the ice internal data types @@ -537,13 +542,9 @@ subroutine ice_import( importState, rc ) if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_halo') -#endif call ice_HaloUpdate(aflds, halo_info, field_loc_center, field_type_vector) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_halo') -#endif endif !$OMP PARALLEL DO PRIVATE(iblk,i,j) @@ -656,9 +657,8 @@ subroutine ice_import( importState, rc ) ! interpolate across the pole) ! use ANGLET which is on the T grid ! -#ifdef CESMCOUPLED call t_startf ('cice_imp_ocn') -#endif + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks @@ -667,14 +667,16 @@ subroutine ice_import( importState, rc ) ! ocean workx = uocn (i,j,iblk) ! currents, m/s worky = vocn (i,j,iblk) - uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + uocn(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! rotate to align with model i,j + worky*sin(ANGLET(i,j,iblk)) vocn(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - workx*sin(ANGLET(i,j,iblk)) workx = ss_tltx (i,j,iblk) ! sea sfc tilt, m/m worky = ss_tlty (i,j,iblk) - ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! convert to POP grid + + ss_tltx(i,j,iblk) = workx*cos(ANGLET(i,j,iblk)) & ! rotate to align with model i,j + worky*sin(ANGLET(i,j,iblk)) ss_tlty(i,j,iblk) = worky*cos(ANGLET(i,j,iblk)) & - workx*sin(ANGLET(i,j,iblk)) @@ -682,47 +684,46 @@ subroutine ice_import( importState, rc ) sst(i,j,iblk) = sst(i,j,iblk) - Tffresh ! sea sfc temp (C) sss(i,j,iblk) = max(sss(i,j,iblk),c0) -#ifndef CESMCOUPLED -!tcx should this be icepack_sea_freezing_temperature? - Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) -#endif + enddo enddo + end do #ifdef CESMCOUPLED - ! Use shr_frz_mod for this, overwrite Tf computed above - Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) + ! Use shr_frz_mod for this + Tf(:,:,iblk) = shr_frz_freezetemp(sss(:,:,iblk)) +#else + !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) + do iblk = 1, nblocks + do j = 1,ny_block + do i = 1,nx_block + !TODO: tcx should this be icepack_sea_freezing_temperature? + Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) + end do + end do + end do + !$OMP END PARALLEL DO #endif - enddo - !$OMP END PARALLEL DO -#ifdef CESMCOUPLED call t_stopf ('cice_imp_ocn') -#endif ! Interpolate ocean dynamics variables from T-cell centers to ! U-cell centers. if (.not.prescribed_ice) then -#ifdef CESMCOUPLED call t_startf ('cice_imp_t2u') -#endif call t2ugrid_vector(uocn) call t2ugrid_vector(vocn) call t2ugrid_vector(ss_tltx) call t2ugrid_vector(ss_tlty) -#ifdef CESMCOUPLED call t_stopf ('cice_imp_t2u') -#endif end if ! Atmosphere variables are needed in T cell centers in ! subroutine stability and are interpolated to the U grid ! later as necessary. -#ifdef CESMCOUPLED call t_startf ('cice_imp_atm') -#endif !$OMP PARALLEL DO PRIVATE(iblk,i,j,workx,worky) do iblk = 1, nblocks do j = 1, ny_block @@ -743,9 +744,7 @@ subroutine ice_import( importState, rc ) enddo enddo !$OMP END PARALLEL DO -#ifdef CESMCOUPLED call t_stopf ('cice_imp_atm') -#endif end subroutine ice_import diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index dd56ac441..85b4177fd 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -95,6 +95,8 @@ module ice_prescribed_mod contains !=============================================================================== +#ifdef CESM_COUPLED + subroutine ice_prescribed_init(mpicom, compid, gindex) use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat @@ -647,6 +649,15 @@ subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) end subroutine ice_prescribed_set_domain +#else + ! This is a stub routine for now + subroutine ice_prescribed_init(mpicom, compid, gindex) + integer(kind=int_kind), intent(in) :: mpicom + integer(kind=int_kind), intent(in) :: compid + integer(kind=int_kind), intent(in) :: gindex(:) + ! do nothing + end subroutine ice_prescribed_init + #endif end module ice_prescribed_mod From 3a1b88bffa5abe4741be4effb9f13fcbfe07b189 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 4 Jul 2020 13:25:48 -0600 Subject: [PATCH 17/44] fix compile errors --- cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 4 ++-- cicecore/drivers/nuopc/cmeps/ice_import_export.F90 | 8 ++++---- cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 | 5 ++++- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index c3947cb98..53c57f721 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -48,8 +48,8 @@ module ice_comp_nuopc #ifdef CESMCOUPLED use shr_const_mod use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT - use ice_prescribed_mod , only : ice_prescribed_init #endif + use ice_prescribed_mod , only : ice_prescribed_init implicit none private @@ -834,7 +834,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent and isSet) then + if (isPresent .and. isSet) then read(cvalue,*) compid ! convert from string to integer else compid = 0 diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index da022ddcf..9adb868db 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -35,7 +35,7 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature - use ice_wrapper_mod , only : t_startf, t_stopf, t_barrierf + use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp #endif @@ -171,7 +171,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) !cesm call fldlist_add(fldsToIce_num, fldsToIce, 'air_density_height_lowest' ) !cesm - ! the folloing are advertised but might not be connected if they are not present + ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific ! from atm - black carbon deposition fluxes (3) call fldlist_add(fldsToIce_num, fldsToIce, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) @@ -253,8 +253,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ungridded_lbound=1, ungridded_ubound=3) + !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ! ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 85b4177fd..4104b70b4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -7,6 +7,9 @@ module ice_prescribed_mod implicit none private ! except + ! MEMBER FUNCTIONS: + public :: ice_prescribed_init ! initialize input data stream + logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice #else @@ -90,6 +93,7 @@ module ice_prescribed_mod ! , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) ! , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) ! ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 +#endif !======================================================================= contains @@ -657,7 +661,6 @@ subroutine ice_prescribed_init(mpicom, compid, gindex) integer(kind=int_kind), intent(in) :: gindex(:) ! do nothing end subroutine ice_prescribed_init - #endif end module ice_prescribed_mod From 41855fde3b5a463b20455cc4bfb8a5af6a16436f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Jul 2020 14:29:12 -0600 Subject: [PATCH 18/44] fixes to get cesm working --- .../drivers/nuopc/cmeps/cice_wrapper_mod.F90 | 7 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 159 ++++++------------ 2 files changed, 56 insertions(+), 110 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 index e350e9a52..0da2ed491 100644 --- a/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/cice_wrapper_mod.F90 @@ -1,13 +1,12 @@ module cice_wrapper_mod #ifdef CESMCOUPLED - use perf_mod, only : t_startf, t_stopf, t_barrierf -#endif - + use perf_mod , only : t_startf, t_stopf, t_barrierf + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit +#else contains -#ifndef CESMCOUPLED ! These are just stub routines put in place to remove subroutine shr_file_setLogUnit(nunit) diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 4104b70b4..78ea39b4e 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -1,5 +1,12 @@ module ice_prescribed_mod + ! !DESCRIPTION: + ! The prescribed ice model reads in ice concentration data from a netCDF + ! file. Ice thickness, temperature, the ice temperature profile are + ! prescribed. Air/ice fluxes are computed to get surface temperature, + ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. + ! Regridding and data cycling capabilities are included. + #ifndef CESMCOUPLED use ice_kinds_mod @@ -7,22 +14,21 @@ module ice_prescribed_mod implicit none private ! except - ! MEMBER FUNCTIONS: public :: ice_prescribed_init ! initialize input data stream - logical(kind=log_kind), parameter, public :: prescribed_ice = .false. ! true if prescribed ice -#else +contains + ! This is a stub routine for now + subroutine ice_prescribed_init(mpicom, compid, gindex) + integer(kind=int_kind), intent(in) :: mpicom + integer(kind=int_kind), intent(in) :: compid + integer(kind=int_kind), intent(in) :: gindex(:) + ! do nothing + end subroutine ice_prescribed_init - ! !DESCRIPTION: - ! The prescribed ice model reads in ice concentration data from a netCDF - ! file. Ice thickness, temperature, the ice temperature profile are - ! prescribed. Air/ice fluxes are computed to get surface temperature, - ! Ice/ocean fluxes are set to zero, and ice dynamics are not calculated. - ! Regridding and data cycling capabilities are included. +#else - ! !USES: - use shr_nl_mod, only : shr_nl_find_group_name + use shr_nl_mod , only : shr_nl_find_group_name use shr_strdata_mod use shr_dmodel_mod use shr_string_mod @@ -31,24 +37,23 @@ module ice_prescribed_mod use shr_mct_mod use mct_mod use pio - use ice_broadcast - use ice_communicate , only : my_task, master_task, MPI_COMM_ICE + use ice_communicate , only : my_task, master_task, MPI_COMM_ICE use ice_kinds_mod use ice_fileunits - use ice_exit , only : abort_ice - use ice_domain_size , only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks + use ice_exit , only : abort_ice + use ice_domain_size , only : nx_global, ny_global, ncat, nilyr, nslyr, max_blocks use ice_constants - use ice_blocks , only : nx_block, ny_block, block, get_block - use ice_domain , only : nblocks, distrb_info, blocks_ice - use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac - use ice_calendar , only : idate, sec, calendar_type - use ice_arrays_column, only : hin_max + use ice_blocks , only : nx_block, ny_block, block, get_block + use ice_domain , only : nblocks, distrb_info, blocks_ice + use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac + use ice_calendar , only : idate, sec, calendar_type + use ice_arrays_column , only : hin_max use ice_read_write - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_query_tracer_indices, icepack_query_tracer_sizes - use icepack_intfc, only: icepack_query_parameters + use ice_exit , only: abort_ice + use icepack_intfc , only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc , only: icepack_query_tracer_indices, icepack_query_tracer_sizes + use icepack_intfc , only: icepack_query_parameters implicit none private ! except @@ -59,59 +64,38 @@ module ice_prescribed_mod public :: ice_prescribed_phys ! set prescribed ice state and fluxes ! !PUBLIC DATA MEMBERS: - logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice - + logical(kind=log_kind), public :: prescribed_ice ! true if prescribed ice integer(kind=int_kind),parameter :: nFilesMaximum = 400 ! max number of files - integer(kind=int_kind) :: stream_year_first ! first year in stream to use - integer(kind=int_kind) :: stream_year_last ! last year in stream to use - integer(kind=int_kind) :: model_year_align ! align stream_year_first - ! with this model year - - character(len=char_len_long) :: stream_fldVarName - character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) - character(len=char_len_long) :: stream_domTvarName - character(len=char_len_long) :: stream_domXvarName - character(len=char_len_long) :: stream_domYvarName - character(len=char_len_long) :: stream_domAreaName - character(len=char_len_long) :: stream_domMaskName - character(len=char_len_long) :: stream_domFileName - character(len=char_len_long) :: stream_mapread - logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required - - type(shr_strdata_type) :: sdat ! prescribed data stream - character(len=char_len_long) :: fldList ! list of fields in data stream - real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover - -! real (kind=dbl_kind), parameter :: & -! cp_sno = 0.0_dbl_kind & ! specific heat of snow (J/kg/K) -! , rLfi = Lfresh*rhoi & ! latent heat of fusion ice (J/m^3) -! , rLfs = Lfresh*rhos & ! latent heat of fusion snow (J/m^3) -! , rLvi = Lvap*rhoi & ! latent heat of vapor*rhoice (J/m^3) -! , rLvs = Lvap*rhos & ! latent heat of vapor*rhosno (J/m^3) -! , rcpi = cp_ice*rhoi & ! heat capacity of fresh ice (J/m^3) -! , rcps = cp_sno*rhos & ! heat capacity of snow (J/m^3) -! , rcpidepressT = rcpi*depressT & ! param for finding T(z) from q (J/m^3) -! , rLfidepressT = rLfi*depressT ! param for heat capacity (J deg/m^3) -! ! heat capacity of sea ice, rhoi*C=rcpi+rLfidepressT*salinity/T^2 -#endif + integer(kind=int_kind) :: stream_year_first ! first year in stream to use + integer(kind=int_kind) :: stream_year_last ! last year in stream to use + integer(kind=int_kind) :: model_year_align ! align stream_year_first with this model year + character(len=char_len_long) :: stream_fldVarName + character(len=char_len_long) :: stream_fldFileName(nFilesMaximum) + character(len=char_len_long) :: stream_domTvarName + character(len=char_len_long) :: stream_domXvarName + character(len=char_len_long) :: stream_domYvarName + character(len=char_len_long) :: stream_domAreaName + character(len=char_len_long) :: stream_domMaskName + character(len=char_len_long) :: stream_domFileName + character(len=char_len_long) :: stream_mapread + logical(kind=log_kind) :: prescribed_ice_fill ! true if data fill required + type(shr_strdata_type) :: sdat ! prescribed data stream + character(len=char_len_long) :: fldList ! list of fields in data stream + real(kind=dbl_kind),allocatable :: ice_cov(:,:,:) ! ice cover -!======================================================================= contains -!=============================================================================== - -#ifdef CESM_COUPLED subroutine ice_prescribed_init(mpicom, compid, gindex) - use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat - ! !DESCRIPTION: ! Prescribed ice initialization - needed to ! work with new shr_strdata module derived type - ! !INPUT/OUTPUT PARAMETERS: + use shr_pio_mod, only : shr_pio_getiotype, shr_pio_getiosys, shr_pio_getioformat + implicit none include 'mpif.h' + ! !nput/output parameters: integer(kind=int_kind), intent(in) :: mpicom integer(kind=int_kind), intent(in) :: compid integer(kind=int_kind), intent(in) :: gindex(:) @@ -263,7 +247,6 @@ subroutine ice_prescribed_init(mpicom, compid, gindex) end subroutine ice_prescribed_init !======================================================================= - subroutine ice_prescribed_run(mDateIn, secIn) ! !DESCRIPTION: @@ -335,25 +318,12 @@ subroutine ice_prescribed_run(mDateIn, secIn) end subroutine ice_prescribed_run !=============================================================================== - !BOP =========================================================================== - ! - ! !IROUTINE: ice_prescribed_phys -- set prescribed ice state and fluxes - ! - ! !DESCRIPTION: - ! - ! Set prescribed ice state using input ice concentration; - ! set surface ice temperature to atmospheric value; use - ! linear temperature gradient in ice to ocean temperature. - ! - ! !REVISION HISTORY: - ! 2005-May-23 - J. Schramm - Updated with data models - ! 2004-July - J. Schramm - Modified to allow variable snow cover - ! 2001-May - B. P. Briegleb - Original version - ! - ! !INTERFACE: ------------------------------------------------------------------ - subroutine ice_prescribed_phys + ! Set prescribed ice state using input ice concentration; + ! set surface ice temperature to atmospheric value; use + ! linear temperature gradient in ice to ocean temperature. + ! !USES: use ice_flux use ice_state @@ -395,20 +365,6 @@ subroutine ice_prescribed_phys if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - !----------------------------------------------------------------- - ! Initialize ice state - !----------------------------------------------------------------- - - ! TODO - can we now get rid of the following??? - - ! aicen(:,:,:,:) = c0 - ! vicen(:,:,:,:) = c0 - ! eicen(:,:,:,:) = c0 - - ! do nc=1,ncat - ! trcrn(:,:,nt_Tsfc,nc,:) = Tf(:,:,:) - ! enddo - !----------------------------------------------------------------- ! Set ice cover over land to zero, not sure if this should be ! be done earier, before time/spatial interp?????? @@ -554,7 +510,6 @@ subroutine ice_prescribed_phys end subroutine ice_prescribed_phys !=============================================================================== - subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) ! Arguments @@ -653,14 +608,6 @@ subroutine ice_prescribed_set_domain( lsize, mpicom, gsmap_i, dom_i ) end subroutine ice_prescribed_set_domain -#else - ! This is a stub routine for now - subroutine ice_prescribed_init(mpicom, compid, gindex) - integer(kind=int_kind), intent(in) :: mpicom - integer(kind=int_kind), intent(in) :: compid - integer(kind=int_kind), intent(in) :: gindex(:) - ! do nothing - end subroutine ice_prescribed_init #endif end module ice_prescribed_mod From 30a81cce323bfd6b742e9cb6be00c8708b4f8bde Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 7 Jul 2020 12:17:21 -0600 Subject: [PATCH 19/44] fixed white space issue --- .../infrastructure/ice_read_write.F90 | 30 +++++++------------ 1 file changed, 11 insertions(+), 19 deletions(-) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index 4fa115ee3..f497db49b 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1106,7 +1106,6 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines -! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! dimension size @@ -1114,7 +1113,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & @@ -1280,7 +1279,6 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & n, & ! ncat index varid , & ! variable id status ! status output from netcdf routines -! status , & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1288,7 +1286,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & @@ -1366,7 +1364,7 @@ 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, & +! 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & ! ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar @@ -1837,7 +1835,6 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -1847,8 +1844,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character (char_len) :: & lvarname ! variable name -! lvarname, & ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1 @@ -1959,18 +1955,16 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & integer (kind=int_kind) :: & n, & ! ncat index status ! status output from netcdf routines -! status, & ! status output from netcdf routines -! ndim, nvar, & ! sizes of netcdf file -! id, & ! dimension index -! dimlen ! size of dimension +! ndim, nvar, & ! sizes of netcdf file +! id, & ! dimension index +! dimlen ! size of dimension real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array character (char_len) :: & lvarname ! variable name -! lvarname, & ! variable name -! dimname ! dimension name +! dimname ! dimension name real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g1 @@ -2087,7 +2081,6 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) integer (kind=int_kind) :: & varid, & ! netcdf id for field status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2095,9 +2088,9 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name - +! #ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 @@ -2239,7 +2232,6 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & integer (kind=int_kind) :: & varid , & ! variable id status ! status output from netcdf routines -! status, & ! status output from netcdf routines ! ndim, nvar, & ! sizes of netcdf file ! id, & ! dimension index ! dimlen ! size of dimension @@ -2247,7 +2239,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & real (kind=dbl_kind) :: & amin, amax, asum ! min, max values and sum of input array -! character (char_len) :: & +! character (char_len) :: & ! dimname ! dimension name real (kind=dbl_kind), dimension(:,:), allocatable :: & From 27dd3b7e6003b8aac0977d3a057e9a61ed7305d4 Mon Sep 17 00:00:00 2001 From: David Bailey Date: Tue, 7 Jul 2020 12:40:33 -0600 Subject: [PATCH 20/44] Add restart_coszen namelist option --- cicecore/cicedynB/general/ice_init.F90 | 8 ++++++-- .../infrastructure/ice_restart_driver.F90 | 15 +++------------ .../infrastructure/io/io_netcdf/ice_restart.F90 | 7 ++----- .../infrastructure/io/io_pio2/ice_restart.F90 | 8 +++----- cicecore/shared/ice_restart_shared.F90 | 1 + configuration/scripts/ice_in | 1 + doc/source/cice_index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 1 + doc/source/user_guide/ug_implementation.rst | 4 ++++ 9 files changed, 22 insertions(+), 24 deletions(-) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index f43c08793..91c5d539d 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -73,7 +73,7 @@ subroutine input_data restart_pond_cesm, restart_pond_lvl, restart_pond_topo, restart_aero, & restart_fsd, restart_iso use ice_restart_shared, only: & - restart, restart_ext, restart_dir, restart_file, pointer_file, & + restart, restart_ext, restart_coszen, restart_dir, restart_file, pointer_file, & runid, runtype, use_restart_time, restart_format, lcdf64 use ice_history_shared, only: hist_avg, history_dir, history_file, & incond_dir, incond_file, version_name, & @@ -149,7 +149,8 @@ subroutine input_data dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & - restart_ext, use_restart_time, restart_format, lcdf64, & + restart_ext, restart_coszen, use_restart_time, restart_format, & + lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & @@ -269,6 +270,7 @@ subroutine input_data restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix restart_ext = .false. ! if true, read/write ghost cells + restart_coszen = .false. ! if true, read/write coszen use_restart_time = .true. ! if true, use time info written in file pointer_file = 'ice.restart_file' restart_format = 'default' ! restart file format @@ -563,6 +565,7 @@ subroutine input_data call broadcast_scalar(restart, master_task) call broadcast_scalar(restart_dir, master_task) call broadcast_scalar(restart_ext, master_task) + call broadcast_scalar(restart_coszen, master_task) call broadcast_scalar(use_restart_time, master_task) call broadcast_scalar(restart_format, master_task) call broadcast_scalar(lcdf64, master_task) @@ -1458,6 +1461,7 @@ subroutine input_data write(nu_diag,*) ' restart_dir = ', & trim(restart_dir) write(nu_diag,*) ' restart_ext = ', restart_ext + write(nu_diag,*) ' restart_coszen = ', restart_coszen write(nu_diag,*) ' restart_format = ', & trim(restart_format) write(nu_diag,*) ' lcdf64 = ', & diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index d3829b9c4..7eb7c020d 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -23,7 +23,7 @@ module ice_restart_driver field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_vector use ice_restart_shared, only: restart_dir, pointer_file, & - runid, use_restart_time, lenstr + runid, use_restart_time, lenstr, restart_coszen use ice_restart use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag, nu_rst_pointer, nu_restart, nu_dump @@ -58,9 +58,7 @@ subroutine dumpfile(filename_spec) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_state, only: aicen, vicen, vsnon, trcrn, uvel, vvel character(len=char_len_long), intent(in), optional :: filename_spec @@ -132,9 +130,7 @@ subroutine dumpfile(filename_spec) !----------------------------------------------------------------- ! radiation fields !----------------------------------------------------------------- -#ifdef CESMCOUPLED - call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) -#endif + if (restart_coszen) call write_restart_field(nu_dump,0,coszen,'ruf8','coszen',1,diag) call write_restart_field(nu_dump,0,scale_factor,'ruf8','scale_factor',1,diag) call write_restart_field(nu_dump,0,swvdr,'ruf8','swvdr',1,diag) @@ -209,9 +205,7 @@ subroutine restartfile (ice_ic) stressp_1, stressp_2, stressp_3, stressp_4, & stressm_1, stressm_2, stressm_3, stressm_4, & stress12_1, stress12_2, stress12_3, stress12_4 -#ifdef CESMCOUPLED use ice_flux, only: coszen -#endif use ice_grid, only: tmask, grid_type use ice_state, only: trcr_depend, aice, vice, vsno, trcr, & aice0, aicen, vicen, vsnon, trcrn, aice_init, uvel, vvel, & @@ -310,11 +304,8 @@ subroutine restartfile (ice_ic) if (my_task == master_task) & write(nu_diag,*) 'radiation fields' -#ifdef CESMCOUPLED - call read_restart_field(nu_restart,0,coszen,'ruf8', & -! 'coszen',1,diag, field_loc_center, field_type_scalar) + if (restart_coszen) call read_restart_field(nu_restart,0,coszen,'ruf8', & 'coszen',1,diag) -#endif call read_restart_field(nu_restart,0,scale_factor,'ruf8', & 'scale_factor',1,diag, field_loc_center, field_type_scalar) call read_restart_field(nu_restart,0,swvdr,'ruf8', & diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index d4decf6f7..d3cf954a0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -11,7 +11,7 @@ module ice_restart use netcdf use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & - runid, use_restart_time, lcdf64, lenstr + runid, use_restart_time, lcdf64, lenstr, restart_coszen use ice_fileunits, only: nu_diag, nu_rst_pointer use ice_exit, only: abort_ice use icepack_intfc, only: icepack_query_parameters @@ -227,10 +227,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(ncid,'uvel',dims) call define_rest_field(ncid,'vvel',dims) - -#ifdef CESMCOUPLED - call define_rest_field(ncid,'coszen',dims) -#endif + if (restart_coszen) call define_rest_field(ncid,'coszen',dims) call define_rest_field(ncid,'scale_factor',dims) call define_rest_field(ncid,'swvdr',dims) call define_rest_field(ncid,'swvdf',dims) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 5bb880dc5..b11dcf0d0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -11,7 +11,8 @@ module ice_restart use ice_kinds_mod use ice_restart_shared, only: & restart, restart_ext, restart_dir, restart_file, pointer_file, & - runid, runtype, use_restart_time, restart_format, lcdf64, lenstr + runid, runtype, use_restart_time, restart_format, lcdf64, lenstr, & + restart_coszen use ice_pio use pio use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -245,10 +246,7 @@ subroutine init_restart_write(filename_spec) call define_rest_field(File,'uvel',dims) call define_rest_field(File,'vvel',dims) - -#ifdef CESMCOUPLED - call define_rest_field(File,'coszen',dims) -#endif + if (restart_coszen) call define_rest_field(File,'coszen',dims) call define_rest_field(File,'scale_factor',dims) call define_rest_field(File,'swvdr',dims) call define_rest_field(File,'swvdf',dims) diff --git a/cicecore/shared/ice_restart_shared.F90 b/cicecore/shared/ice_restart_shared.F90 index 82b82c5ce..6578ef3ad 100644 --- a/cicecore/shared/ice_restart_shared.F90 +++ b/cicecore/shared/ice_restart_shared.F90 @@ -11,6 +11,7 @@ module ice_restart_shared logical (kind=log_kind), public :: & restart , & ! if true, initialize using restart file instead of defaults restart_ext, & ! if true, read/write extended grid (with ghost cells) + restart_coszen, & ! if true, read/write coszen use_restart_time ! if true, use time written in core restart file character (len=char_len), public :: & diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 9d35b4366..54663f86c 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -10,6 +10,7 @@ ice_ic = './restart/iced_gx3_v5.nc' restart = .true. restart_ext = .false. + restart_coszen = .false. use_restart_time = .true. restart_format = 'default' lcdf64 = .false. diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 1884d03f1..1d3baca38 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -523,6 +523,7 @@ either Celsius or Kelvin units). "restart_format", ":math:`\bullet` restart file format", "" "restart_[tracer]", ":math:`\bullet` if true, read tracer restart file", "" "restart_ext", ":math:`\bullet` if true, read/write halo cells in restart file", "" + "restart_coszen", ":math:`\bullet` if true, read/write coszen in restart file", "" "restore_bgc", ":math:`\bullet` if true, restore nitrate/silicate to data", "" "restore_ice", ":math:`\bullet` if true, restore ice state along lateral boundaries", "" "restore_ocn", ":math:`\bullet` restore sst to data", "" diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 84d3633b1..5512841a2 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -148,6 +148,7 @@ setup_nml "``restart``", "logical", "initialize using restart file", "``.false.``" "``restart_dir``", "string", "path to restart directory", "'./'" "``restart_ext``", "logical", "read/write halo cells in restart files", "``.false.``" + "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restart_file``", "string", "output file prefix for restart dump", "'iced'" "``restart_format``", "``default``", "read/write restart file with default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index b7d9c0f47..44d4ef1d6 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -569,6 +569,10 @@ An additional namelist option, ``restart_ext`` specifies whether halo cells are included in the restart files. This option is useful for tripole and regional grids, but can not be used with PIO. +An additional namelist option, ``restart_coszen`` specifies whether the +cosine of the zenith angle is included in the restart files. This is mainly +used in coupled models. + MPI is initialized in *init\_communicate* for both coupled and stand-alone MPI runs. The ice component communicates with a flux coupler or other climate components via external routines that handle the From f92bef336c79186daac226af143dccbd20348e95 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 7 Jul 2020 15:20:45 -0400 Subject: [PATCH 21/44] update icepack submodule --- icepack | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/icepack b/icepack index 09a5e19f0..b1e41d9f1 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 09a5e19f006f62f60f6b940a4385feb47451368e +Subproject commit b1e41d9f12a59390aacdb933889c3c4a87c9e8d2 From 8ff4ee0d72eeab8211b71a94af61669adf1550ef Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 7 Jul 2020 15:46:57 -0400 Subject: [PATCH 22/44] change Orion to orion in backend remove duplicate print lines from ice_transport_driver --- cicecore/cicedynB/dynamics/ice_transport_driver.F90 | 6 ------ configuration/scripts/forapps/ufs/comp_ice.backend.libcice | 2 +- 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index a496402f0..c500e1631 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -204,12 +204,6 @@ subroutine init_transport if (nt-k==nt_isoice) & write(nu_diag,1000) 'nt_isoice ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) - if (nt-k==nt_isosno) & - write(nu_diag,*) 'nt_isosno',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) - if (nt-k==nt_isoice) & - write(nu_diag,*) 'nt_isoice',nt,depend(nt),tracer_type(nt),& - has_dependents(nt) if (nt-k==nt_bgc_Nit) & write(nu_diag,1000) 'nt_bgc_Nit ',nt,depend(nt),tracer_type(nt),& has_dependents(nt) diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index ca718548a..886e0a3ff 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -18,7 +18,7 @@ setenv THRD no # set to yes for OpenMP threading if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -else if (${SITE} =~ Orion*) then +else if (${SITE} =~ orion*) then setenv ARCH orion_intel else if (${SITE} =~ hera*) then setenv ARCH hera_intel From 916c6af35222368562697a365a658e8e1bebe955 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 14 Jul 2020 08:18:33 -0400 Subject: [PATCH 23/44] add -link_mpi=dbg to debug flags (#8) --- configuration/scripts/machines/Macros.cheyenne_intel | 2 +- configuration/scripts/machines/Macros.hera_intel | 2 +- configuration/scripts/machines/Macros.orion_intel | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/configuration/scripts/machines/Macros.cheyenne_intel b/configuration/scripts/machines/Macros.cheyenne_intel index 902224766..243295487 100644 --- a/configuration/scripts/machines/Macros.cheyenne_intel +++ b/configuration/scripts/machines/Macros.cheyenne_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.hera_intel b/configuration/scripts/machines/Macros.hera_intel index 519e3a5ba..230f43e70 100644 --- a/configuration/scripts/machines/Macros.hera_intel +++ b/configuration/scripts/machines/Macros.hera_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.orion_intel b/configuration/scripts/machines/Macros.orion_intel index aae839f4e..6dffdd0a2 100644 --- a/configuration/scripts/machines/Macros.orion_intel +++ b/configuration/scripts/machines/Macros.orion_intel @@ -12,7 +12,7 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg else FFLAGS += -O2 endif From 8f37bfc6425cc66ff274f8fe3abc6e0de0ef0f08 Mon Sep 17 00:00:00 2001 From: Minsuk Ji <57227195+MinsukJi-NOAA@users.noreply.github.com> Date: Fri, 17 Jul 2020 09:05:06 -0400 Subject: [PATCH 24/44] cice6 compile (#6) * enable debug build. fix to remove errors * fix an error in comp_ice.backend.libcice * change Orion to orion for machine identification --- configuration/scripts/forapps/ufs/comp_ice.backend.clean | 8 ++++---- .../scripts/forapps/ufs/comp_ice.backend.libcice | 6 ++++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean index 7eef2ed1a..823f1f586 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.clean +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.clean @@ -10,10 +10,10 @@ setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR if (${SITE} =~ cheyenne*) then setenv ARCH cheyenne_intel -#else if (${SITE} =~ Orion*) then -# setenv ARCH orion_intel -#else if (${SITE} =~ hera*) then -# setenv ARCH hera_intel +else if (${SITE} =~ orion*) then + setenv ARCH orion_intel +else if (${SITE} =~ hera*) then + setenv ARCH hera_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index 886e0a3ff..a408cc7d2 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -68,9 +68,11 @@ endif # Build in debug mode. If DEBUG=Y, enable DEBUG compilation. This # flag is set in ${ROOTDIR}/coupledFV3_MOM6_CICE_debug.appBuilder file. if (! $?DEBUG) then - setenv ICE_BLDDEBUG true + setenv ICE_BLDDEBUG false else - if ($DEBUG != "Y") then + if ($DEBUG == "Y") then + setenv ICE_BLDDEBUG true + else setenv ICE_BLDDEBUG false endif endif From bdf1a1f6cd44c595e57c275f69efcf28a069b06a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 12 Aug 2020 15:55:21 -0400 Subject: [PATCH 25/44] changes for consistency w/ current emc-cice5 (#13) Update to emc/develop fork to current CICE consortium Co-authored-by: David A. Bailey Co-authored-by: Tony Craig Co-authored-by: Elizabeth Hunke Co-authored-by: Mariana Vertenstein Co-authored-by: apcraig Co-authored-by: Philippe Blain --- README.md | 10 +- cice.setup | 19 +- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 39 ++-- cicecore/cicedynB/general/ice_flux.F90 | 46 ++++- cicecore/cicedynB/general/ice_forcing.F90 | 91 +++------ cicecore/cicedynB/general/ice_forcing_bgc.F90 | 24 +-- cicecore/cicedynB/general/ice_init.F90 | 97 ++++++---- cicecore/cicedynB/general/ice_step_mod.F90 | 55 +++++- .../comm/mpi/ice_communicate.F90 | 7 + .../comm/mpi/ice_gather_scatter.F90 | 69 +++---- .../infrastructure/comm/mpi/ice_reprosum.F90 | 4 +- .../comm/serial/ice_communicate.F90 | 80 +------- .../comm/serial/ice_reprosum.F90 | 4 +- .../cicedynB/infrastructure/ice_domain.F90 | 24 ++- cicecore/cicedynB/infrastructure/ice_grid.F90 | 34 +++- .../infrastructure/ice_read_write.F90 | 173 +++++++++--------- .../io/io_netcdf/ice_history_write.F90 | 11 +- .../io/io_netcdf/ice_restart.F90 | 39 ++++ .../io/io_pio2/ice_history_write.F90 | 6 - .../infrastructure/io/io_pio2/ice_restart.F90 | 2 +- cicecore/drivers/direct/hadgem3/CICE.F90 | 2 - .../drivers/direct/hadgem3/CICE_FinalMod.F90 | 5 +- .../drivers/direct/hadgem3/CICE_InitMod.F90 | 30 ++- .../drivers/direct/hadgem3/CICE_RunMod.F90 | 20 +- cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 | 5 +- cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 32 ++-- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 23 +-- .../drivers/nuopc/cmeps/CICE_FinalMod.F90 | 5 +- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 8 +- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 48 ++++- .../drivers/nuopc/cmeps/ice_import_export.F90 | 75 ++++---- cicecore/drivers/nuopc/dmi/CICE.F90 | 2 - cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 6 - cicecore/drivers/standalone/cice/CICE.F90 | 2 - .../drivers/standalone/cice/CICE_FinalMod.F90 | 2 - .../drivers/standalone/cice/CICE_InitMod.F90 | 10 - .../drivers/standalone/cice/CICE_RunMod.F90 | 15 +- .../standalone/cice/CICE_RunMod.F90_debug | 4 - cicecore/shared/ice_arrays_column.F90 | 8 + cicecore/shared/ice_init_column.F90 | 14 +- configuration/scripts/cice.build | 4 +- .../forapps/ufs/comp_ice.backend.libcice | 4 +- configuration/scripts/ice_in | 9 +- configuration/scripts/options/set_nml.alt03 | 3 + configuration/scripts/options/set_nml.alt04 | 3 + configuration/scripts/parse_namelist.sh | 27 ++- configuration/scripts/parse_settings.sh | 28 +++ configuration/scripts/tests/cice.lcov.csh | 2 +- .../scripts/tests/cice_test_codecov.csh | 4 +- configuration/scripts/tests/io_suite.ts | 5 +- .../scripts/tests/report_results.csh | 2 +- doc/source/cice_index.rst | 5 + doc/source/intro/citing.rst | 26 ++- doc/source/user_guide/ug_case_settings.rst | 65 ++++++- doc/source/user_guide/ug_implementation.rst | 6 + doc/source/user_guide/ug_running.rst | 37 +++- doc/source/user_guide/ug_testing.rst | 6 +- icepack | 2 +- 58 files changed, 827 insertions(+), 561 deletions(-) diff --git a/README.md b/README.md index 0c5940a7a..a584e8ac9 100644 --- a/README.md +++ b/README.md @@ -11,21 +11,19 @@ CICE is a computationally efficient model for simulating the growth, melting, an This repository contains the files and code needed to run the CICE sea ice numerical model starting with version 6. CICE is maintained by the CICE Consortium. Versions prior to v6 are found in the [CICE-svn-trunk repository](https://github.com/CICE-Consortium/CICE-svn-trunk). -CICE consists of a top level driver and dynamical core plus the [Icepack column physics code][icepack], which is included in CICE as a Git submodule. Because Icepack is a submodule of CICE, Icepack and CICE development are handled independently with respect to the GitHub repositories even though development and testing may be done together. +CICE consists of a top level driver and dynamical core plus the [Icepack][icepack] column physics code], which is included in CICE as a Git submodule. Because Icepack is a submodule of CICE, Icepack and CICE development are handled independently with respect to the GitHub repositories even though development and testing may be done together. [icepack]: https://github.com/CICE-Consortium/Icepack -The first point of contact with the CICE Consortium is the [Consortium Community Forum][forum]. +The first point of contact with the CICE Consortium is the Consortium Community [Forum][forum]. This forum is monitored by Consortium members and also opened to the whole community. Please do not use our issue tracker for general support questions. -[doc-resources]: https://github.com/CICE-Consortium/About-Us/wiki/Resource-Index#model-documentation -[doc-running]: https://cice-consortium-cice.readthedocs.io/en/master/user_guide/ug_running.html [forum]: https://xenforo.cgd.ucar.edu/cesm/forums/cice-consortium.146/ If you expect to make any changes to the code, we recommend that you first fork both the CICE and Icepack repositories. In order to incorporate your developments into the Consortium code it is imperative you follow the guidance for Pull Requests and requisite testing. -Head over to our [Contribution guide][contributing] to learn more about how you can help improve CICE. +Head over to our [Contributing][contributing] guide to learn more about how you can help improve CICE. [contributing]: https://github.com/CICE-Consortium/About-Us/wiki/Contributing @@ -34,7 +32,7 @@ Head over to our [Contribution guide][contributing] to learn more about how you Information about the CICE model -* **CICE Version Index**: https://github.com/CICE-Consortium/CICE/wiki/CICE-Version-Index +* **CICE Release Table**: https://github.com/CICE-Consortium/CICE/wiki/CICE-Release-Table Numbered CICE releases since version 6 with associated documentation and DOIs. diff --git a/cice.setup b/cice.setup index 43fdd836c..3efe94827 100755 --- a/cice.setup +++ b/cice.setup @@ -40,6 +40,7 @@ set suitebuild = true set suitereuse = true set suiterun = false set suitesubmit = true +set ignoreuserset = false if ($#argv < 1) then set helpheader = 1 @@ -98,6 +99,7 @@ DESCRIPTION --acct : account number for the batch submission --grid, -g : grid, grid (default = ${grid}) --set, -s : case option setting(s), comma separated (default = " ") + --ignore-user-set: ignore ~/.cice_set if it exists --queue : queue for the batch submission For testing @@ -112,7 +114,7 @@ DESCRIPTION --diff : generate comparison against another case --report : automatically post results when tests are complete --coverage : generate and report test coverage metrics when tests are complete, - requires GNU compiler (ie. normally ``--env gnu``) + requires GNU compiler (ie. normally --env gnu) --setup-only : for suite, setup testcases, no build, no submission --setup-build : for suite, setup and build testcases, no submission --setup-build-run : for suite, setup, build, and run interactively @@ -263,6 +265,10 @@ while (1) set suitesubmit = true shift argv + else if ("$option" == "--ignore-user-set") then + set ignoreuserset = true + shift argv + # arguments with settings else shift argv @@ -412,6 +418,17 @@ set vers = ${ICE_VERSION} set shhash = `echo ${hash} | cut -c 1-10` if ( ${dosuite} == 0 ) then + # grab user defined default sets + if ("${ignoreuserset}" == "false" && -e ~/.cice_set) then + set setsu1 = `cat ~/.cice_set` + # get rid of spaces if they exist! + set setsuser = `echo ${setsu1} | sed 's/ //g'` + if ( ${sets} == "" ) then + set sets = "${setsuser}" + else + set sets = "${setsuser},${sets}" + endif + endif set teststring = "${test} ${grid} ${pesx} ${sets}" if ( $bfbcomp != ${spval} ) then if ( ${sets} == "" ) then diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 index df50dd99e..c3dc83a24 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -35,10 +35,11 @@ module ice_dyn_shared ndte ! number of subcycles: ndte=dt/dte character (len=char_len), public :: & - coriolis ! 'constant', 'zero', or 'latitude' + coriolis , & ! 'constant', 'zero', or 'latitude' + 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 @@ -475,9 +476,7 @@ subroutine dyn_prep2 (nx_block, ny_block, & integer (kind=int_kind) :: & i, j, ij -#ifdef coupled real (kind=dbl_kind) :: gravit -#endif logical (kind=log_kind), dimension(nx_block,ny_block) :: & iceumask_old ! old-time iceumask @@ -577,12 +576,12 @@ subroutine dyn_prep2 (nx_block, ny_block, & ! Define variables for momentum equation !----------------------------------------------------------------- -#ifdef coupled - call icepack_query_parameters(gravit_out=gravit) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) -#endif + if (trim(ssh_stress) == 'coupled') then + call icepack_query_parameters(gravit_out=gravit) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + endif do ij = 1, icellu i = indxui(ij) @@ -597,14 +596,18 @@ subroutine dyn_prep2 (nx_block, ny_block, & watery(i,j) = vocn(i,j)*cosw + uocn(i,j)*sinw*sign(c1,fm(i,j)) ! combine tilt with wind stress -#ifndef coupled - ! calculate tilt from geostrophic currents if needed - strtltx(i,j) = -fm(i,j)*vocn(i,j) - strtlty(i,j) = fm(i,j)*uocn(i,j) -#else - strtltx(i,j) = -gravit*umass(i,j)*ss_tltx(i,j) - strtlty(i,j) = -gravit*umass(i,j)*ss_tlty(i,j) -#endif + if (trim(ssh_stress) == 'geostrophic') then + ! calculate tilt from geostrophic currents if needed + strtltx(i,j) = -fm(i,j)*vocn(i,j) + strtlty(i,j) = fm(i,j)*uocn(i,j) + elseif (trim(ssh_stress) == 'coupled') then + strtltx(i,j) = -gravit*umass(i,j)*ss_tltx(i,j) + strtlty(i,j) = -gravit*umass(i,j)*ss_tlty(i,j) + else + call abort_ice(subname//' ERROR: unknown ssh_stress='//trim(ssh_stress), & + file=__FILE__, line=__LINE__) + endif + forcex(i,j) = strairx(i,j) + strtltx(i,j) forcey(i,j) = strairy(i,j) + strtlty(i,j) enddo diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 6b16edb77..97b726fdb 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -217,7 +217,11 @@ 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) - fswthru ! shortwave penetrating to ocean (W/m^2) + 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) + fswthru_idr , & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthru_idf ! nir dif shortwave penetrating to ocean (W/m^2) ! internal @@ -307,6 +311,11 @@ module ice_flux fresh_da, & ! fresh water flux to ocean due to data assim (kg/m^2/s) fsalt_da ! salt flux to ocean due to data assimilation(kg/m^2/s) + real (kind=dbl_kind), dimension (:,:,:,:), allocatable, public :: & + fswthrun_ai ! per-category fswthru * ai (W/m^2) + + logical (kind=log_kind), public :: send_i2x_per_cat = .false. + !----------------------------------------------------------------- ! internal !----------------------------------------------------------------- @@ -438,6 +447,10 @@ subroutine alloc_flux 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) 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) + fswthru_idr (nx_block,ny_block,max_blocks), & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthru_idf (nx_block,ny_block,max_blocks), & ! nir dif shortwave penetrating to ocean (W/m^2) scale_factor (nx_block,ny_block,max_blocks), & ! scaling factor for shortwave components strairx_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, x-direction strairy_ocn(nx_block,ny_block,max_blocks), & ! stress on ocean by air, y-direction @@ -684,6 +697,10 @@ subroutine init_coupler_flux fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 + fswthru_vdr (:,:,:) = c0 + fswthru_vdf (:,:,:) = c0 + fswthru_idr (:,:,:) = c0 + fswthru_idf (:,:,:) = c0 fresh_da(:,:,:) = c0 ! data assimilation fsalt_da(:,:,:) = c0 flux_bio (:,:,:,:) = c0 ! bgc @@ -701,6 +718,11 @@ subroutine init_coupler_flux ffep (:,:,:,:)= c0 ffed (:,:,:,:)= c0 + if (send_i2x_per_cat) then + allocate(fswthrun_ai(nx_block,ny_block,ncat,max_blocks)) + fswthrun_ai(:,:,:,:) = c0 + endif + !----------------------------------------------------------------- ! derived or computed fields !----------------------------------------------------------------- @@ -783,6 +805,10 @@ subroutine init_flux_ocn fpond (:,:,:) = c0 fhocn (:,:,:) = c0 fswthru (:,:,:) = c0 + fswthru_vdr (:,:,:) = c0 + fswthru_vdf (:,:,:) = c0 + fswthru_idr (:,:,:) = c0 + fswthru_idf (:,:,:) = c0 faero_ocn (:,:,:,:) = c0 fiso_ocn (:,:,:,:) = c0 @@ -790,6 +816,10 @@ subroutine init_flux_ocn H2_16O_ocn (:,:,:) = c0 H2_18O_ocn (:,:,:) = c0 + if (send_i2x_per_cat) then + fswthrun_ai(:,:,:,:) = c0 + endif + end subroutine init_flux_ocn !======================================================================= @@ -978,6 +1008,8 @@ subroutine scale_fluxes (nx_block, ny_block, & Tref, Qref, & fresh, fsalt, & fhocn, fswthru, & + fswthru_vdr, fswthru_vdf, & + fswthru_idr, fswthru_idf, & faero_ocn, & alvdr, alidr, & alvdf, alidf, & @@ -1022,6 +1054,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt , & ! salt flux to ocean (kg/m2/s) fhocn , & ! actual ocn/ice heat flx (W/m**2) fswthru , & ! sw radiation through ice bot (W/m**2) + fswthru_vdr , & ! vis dir sw radiation through ice bot (W/m**2) + fswthru_vdf , & ! vis dif sw radiation through ice bot (W/m**2) + fswthru_idr , & ! nir dir sw radiation through ice bot (W/m**2) + fswthru_idf , & ! nir dif sw radiation through ice bot (W/m**2) alvdr , & ! visible, direct (fraction) alidr , & ! near-ir, direct (fraction) alvdf , & ! visible, diffuse (fraction) @@ -1090,6 +1126,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = fsalt (i,j) * ar fhocn (i,j) = fhocn (i,j) * ar fswthru (i,j) = fswthru (i,j) * ar + fswthru_vdr (i,j) = fswthru_vdr (i,j) * ar + fswthru_vdf (i,j) = fswthru_vdf (i,j) * ar + fswthru_idr (i,j) = fswthru_idr (i,j) * ar + fswthru_idf (i,j) = fswthru_idf (i,j) * ar alvdr (i,j) = alvdr (i,j) * ar alidr (i,j) = alidr (i,j) * ar alvdf (i,j) = alvdf (i,j) * ar @@ -1118,6 +1158,10 @@ subroutine scale_fluxes (nx_block, ny_block, & fsalt (i,j) = c0 fhocn (i,j) = c0 fswthru (i,j) = c0 + fswthru_vdr (i,j) = c0 + fswthru_vdf (i,j) = c0 + fswthru_idr (i,j) = c0 + fswthru_idf (i,j) = c0 alvdr (i,j) = c0 ! zero out albedo where ice is absent alidr (i,j) = c0 alvdf (i,j) = c0 diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 66a7d9ef3..4c88037ed 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Reads and interpolates forcing data for atmosphere and ocean quantities. @@ -300,9 +303,6 @@ subroutine init_forcing_ocn(dt) use ice_domain, only: nblocks use ice_domain_size, only: max_blocks use ice_flux, only: sss, sst, Tf -#ifdef ncdf - use netcdf -#endif real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -866,7 +866,6 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data_nc)' -#ifdef ncdf integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -967,9 +966,6 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute -#endif end subroutine read_data_nc !======================================================================= @@ -1007,7 +1003,6 @@ subroutine read_data_nc_hycom (flag, recd, & intent(out) :: & field_data ! 2 values needed for interpolation -#ifdef ncdf ! local variables integer (kind=int_kind) :: & fid ! file id for netCDF routines @@ -1040,11 +1035,6 @@ subroutine read_data_nc_hycom (flag, recd, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute - write(*,*)'ERROR: CICE not compiled with NetCDF' - stop -#endif end subroutine read_data_nc_hycom !======================================================================= @@ -3342,9 +3332,6 @@ subroutine oned_data use ice_flux, only: uatm, vatm, Tair, fsw, fsnow, Qa, rhoa, frain -#ifdef ncdf - use netcdf - ! local parameters character (char_len_long) :: & @@ -3402,7 +3389,7 @@ subroutine oned_data Temp = work Tair(:,:,:) = Temp - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) ! hourly solar data beginning Jan 1, 1989, 01:00 met_file = fsw_file @@ -3412,7 +3399,7 @@ subroutine oned_data call ice_read_nc(fid,istep1,fieldname,work,diag) fsw(:,:,:) = work - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) ! hourly interpolated monthly data beginning Jan 1, 1989, 01:00 met_file = humid_file @@ -3426,7 +3413,7 @@ subroutine oned_data call ice_read_nc(fid,istep1,fieldname,work,diag) fsnow(:,:,:) = work - if (my_task == master_task) status = nf90_close(fid) + call ice_close_nc(fid) !------------------------------------------------------------------- ! Find specific humidity using Hyland-Wexler formulation @@ -3447,8 +3434,6 @@ subroutine oned_data cldf (:,:,:) = p25 ! cloud fraction frain(:,:,:) = c0 ! this is available in hourlymet_rh file -#endif - end subroutine oned_data !======================================================================= @@ -3648,7 +3633,7 @@ subroutine ocn_data_ncar_init use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -3664,7 +3649,6 @@ subroutine ocn_data_ncar_init 'T', 'S', 'hblt', 'U', 'V', & 'dhdx', 'dhdy', 'qdp' / -#ifdef ncdf integer (kind=int_kind) :: & fid , & ! file id dimid ! dimension id @@ -3673,7 +3657,6 @@ subroutine ocn_data_ncar_init status , & ! status flag nlat , & ! number of longitudes of data nlon ! number of latitudes of data -#endif real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & work1 @@ -3701,7 +3684,7 @@ subroutine ocn_data_ncar_init endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then call ice_open_nc(sst_file, fid) @@ -3741,7 +3724,10 @@ subroutine ocn_data_ncar_init enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) + if (my_task == master_task) call ice_close_nc(fid) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(sst_file), & + file=__FILE__, line=__LINE__) #endif else ! binary format @@ -3803,11 +3789,11 @@ subroutine ocn_data_ncar_init_3D use ice_domain_size, only: max_blocks use ice_grid, only: to_ugrid, ANGLET use ice_read_write, only: ice_read_nc_uv -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & n , & ! field index m , & ! month index @@ -3856,7 +3842,7 @@ subroutine ocn_data_ncar_init_3D endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then call ice_open_nc(sst_file, fid) @@ -3902,7 +3888,7 @@ subroutine ocn_data_ncar_init_3D enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) + if (my_task == master_task) call ice_close_nc(fid) ! Rotate vector quantities and shift to U-grid do n=4,6,2 @@ -3923,6 +3909,9 @@ subroutine ocn_data_ncar_init_3D enddo ! month loop enddo ! field loop +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif else ! binary format @@ -4327,9 +4316,6 @@ subroutine ocn_data_hycom_init use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks use ice_flux, only: sss, sst, Tf -#ifdef ncdf - use netcdf -#endif integer (kind=int_kind) :: & i, j, iblk , & ! horizontal indices @@ -4611,7 +4597,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data_nc_point)' -#ifdef ncdf integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -4723,9 +4708,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & call ice_timer_stop(timer_readwrite) ! reading/writing -#else - field_data = c0 ! to satisfy intent(out) attribute -#endif end subroutine read_data_nc_point !======================================================================= @@ -4779,13 +4761,9 @@ subroutine ISPOL_data ! use ice_flux, only: uatm, vatm, Tair, fsw, Qa, rhoa, & frain, fsnow, flw -#ifdef ncdf - use netcdf -#endif !local parameters -#ifdef ncdf character (char_len_long) :: & met_file, & ! netcdf filename fieldname ! field name in netcdf file @@ -4822,7 +4800,6 @@ subroutine ISPOL_data sec1hr ! number of seconds in 1 hour logical (kind=log_kind) :: read1 -#endif integer (kind=int_kind) :: & recnum , & ! record number @@ -4830,7 +4807,6 @@ subroutine ISPOL_data character(len=*), parameter :: subname = '(ISPOL_data)' -#ifdef ncdf call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -4965,14 +4941,6 @@ subroutine ISPOL_data flw(:,:,:) = c1intp * flw_data_p(1) & + c2intp * flw_data_p(2) endif !nc -#else - - uatm(:,:,:) = c0 !wind velocity (m/s) - vatm(:,:,:) = c0 - fsw(:,:,:) = c0 - fsnow (:,:,:) = c0 - -#endif !flw given cldf and Tair calculated in prepare_forcing @@ -5015,11 +4983,7 @@ subroutine ocn_data_ispol_init ! use ice_gather_scatter use ice_read_write -#ifdef ncdf - use netcdf -#endif -#ifdef ncdf integer (kind=int_kind) :: & n , & ! field index m ! month index @@ -5038,7 +5002,6 @@ subroutine ocn_data_ispol_init integer (kind=int_kind) :: & status ! status flag -#endif character(len=*), parameter :: subname = '(ocn_data_ispol_init)' @@ -5058,7 +5021,6 @@ subroutine ocn_data_ispol_init endif ! master_task if (trim(ocn_data_format) == 'nc') then -#ifdef ncdf if (my_task == master_task) then call ice_open_nc(sst_file, fid) endif ! master_task @@ -5078,8 +5040,7 @@ subroutine ocn_data_ispol_init enddo ! month loop enddo ! field loop - if (my_task == master_task) status = nf90_close(fid) -#endif + if (my_task == master_task) call ice_close_nc(fid) else ! binary format call abort_ice (error_message=subname//'new ocean forcing is netcdf only', & @@ -5188,9 +5149,6 @@ subroutine get_wave_spec use ice_constants, only: c0 use ice_domain_size, only: nfreq use ice_timers, only: ice_timer_start, ice_timer_stop, timer_fsd -#ifdef ncdf - use netcdf -#endif ! local variables integer (kind=int_kind) :: & @@ -5228,16 +5186,19 @@ subroutine get_wave_spec ! read more realistic data from a file if ((trim(wave_spec_type) == 'constant').OR.(trim(wave_spec_type) == 'random')) then if (trim(wave_spec_file(1:4)) == 'unkn') then - call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file)) + call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file), & + file=__FILE__, line=__LINE__) else -#ifdef ncdf +#ifdef USE_NETCDF call ice_open_nc(wave_spec_file,fid) call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), dbug, & field_loc_center, field_type_scalar) call ice_close_nc(fid) #else - write (nu_diag,*) "wave spectrum file not available, requires ncdf" + write (nu_diag,*) "wave spectrum file not available, requires cpp USE_NETCDF" write (nu_diag,*) "wave spectrum file not available, using default profile" + call abort_ice (subname//'ERROR: wave_spec_file '//trim(wave_spec_file), & + file=__FILE__, line=__LINE__) #endif endif endif diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index 4eedcfb80..e5ef851fa 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Reads and interpolates forcing data for biogeochemistry @@ -587,7 +590,6 @@ subroutine faero_data use ice_flux_bgc, only: faero_atm use ice_forcing, only: interp_coeff_monthly, read_clim_data_nc, interpolate_data -#ifdef ncdf ! local parameters real (kind=dbl_kind), dimension(:,:,:,:), allocatable, & @@ -672,7 +674,6 @@ subroutine faero_data where (faero_atm(:,:,:,:) > 1.e20) faero_atm(:,:,:,:) = c0 deallocate( aero1_data, aero2_data, aero3_data ) -#endif end subroutine faero_data @@ -688,7 +689,6 @@ subroutine fzaero_data use ice_flux_bgc, only: faero_atm use ice_forcing, only: interp_coeff_monthly, read_clim_data_nc, interpolate_data -#ifdef ncdf ! local parameters real (kind=dbl_kind), dimension(:,:,:,:), allocatable, & @@ -766,7 +766,6 @@ subroutine fzaero_data where (faero_atm(:,:,nlt_zaero(1),:) > 1.e20) faero_atm(:,:,nlt_zaero(1),:) = c0 deallocate( aero_data ) -#endif end subroutine fzaero_data @@ -780,10 +779,6 @@ subroutine init_bgc_data (fed1,fep1) use ice_read_write, only: ice_open_nc, ice_read_nc, ice_close_nc -#ifdef ncdf - use netcdf -#endif - real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & fed1, & ! first dissolved iron pool (nM) fep1 ! first particulate iron pool (nM) @@ -868,7 +863,7 @@ subroutine faero_optics gaer_bc_tab, & ! BC aerosol asymmetry parameter (cos(theta)) bcenh ! BC absorption enhancement facto -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -876,7 +871,6 @@ subroutine faero_optics logical (kind=log_kind) :: modal_aero -#ifdef ncdf integer (kind=int_kind) :: & varid , & ! variable id status , & ! status output from netcdf routines @@ -891,7 +885,6 @@ subroutine faero_optics character (char_len_long) :: & optics_file, & ! netcdf filename fieldname ! field name in netcdf file -#endif character(len=*), parameter :: subname = '(faero_optics)' @@ -968,8 +961,8 @@ subroutine faero_optics if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -#ifdef ncdf if (modal_aero) then +#ifdef USE_NETCDF optics_file = & '/usr/projects/climate/njeffery/DATA/CAM/snicar/snicar_optics_5bnd_mam_c140303.nc' @@ -1004,12 +997,11 @@ subroutine faero_optics call broadcast_array(bcenh(n,:,k), master_task) enddo enddo - endif ! modal_aero #else - if (modal_aero) then - call abort_ice(subname//'ERROR: netcdf required for modal_aero') - endif + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + endif ! modal_aero end subroutine faero_optics diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index 91c5d539d..d3b096eb3 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -59,7 +59,7 @@ subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt - use ice_domain, only: close_boundaries, ns_boundary_type + use ice_domain, only: close_boundaries, ns_boundary_type, orca_halogrid use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & @@ -92,12 +92,13 @@ subroutine input_data 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, & + bathymetry_format, & grid_type, grid_format, & dxrect, dyrect use ice_dyn_shared, only: ndte, kdyn, revised_evp, yield_curve, & kevp_kernel, & basalstress, k1, k2, alphab, threshold_hw, & - Ktens, e_ratio, coriolis, & + Ktens, e_ratio, coriolis, ssh_stress, & kridge, ktransport, brlx, arlx use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice @@ -117,7 +118,8 @@ subroutine input_data ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, emissivity, & 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 + phi_c_slow_mode, phi_i_mushy, kalg, atmiter_conv, Pstar, Cstar, & + sw_frac, sw_dtemp integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound @@ -125,7 +127,8 @@ subroutine input_data character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & tfrz_option, frzpnd, atmbndy, wave_spec_type - logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec + logical (kind=log_kind) :: calc_Tsfc, formdrag, highfreq, calc_strair, wave_spec, & + sw_redist logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd @@ -149,8 +152,7 @@ subroutine input_data dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & - restart_ext, restart_coszen, use_restart_time, restart_format, & - lcdf64, & + restart_ext, use_restart_time, restart_format, lcdf64, & pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & @@ -161,10 +163,10 @@ subroutine input_data namelist /grid_nml/ & grid_format, grid_type, grid_file, kmt_file, & - bathymetry_file, use_bathymetry, nfsd, & + bathymetry_file, use_bathymetry, nfsd, bathymetry_format, & ncat, nilyr, nslyr, nblyr, & kcatbound, gridcpl_file, dxrect, dyrect, & - close_boundaries + close_boundaries, orca_halogrid namelist /tracer_nml/ & tr_iage, restart_age, & @@ -182,12 +184,13 @@ subroutine input_data namelist /thermo_nml/ & kitd, ktherm, conduct, ksno, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, & - dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy + dSdt_slow_mode, phi_c_slow_mode, phi_i_mushy, & + sw_redist, sw_frac, sw_dtemp namelist /dynamics_nml/ & kdyn, ndte, revised_evp, yield_curve, & kevp_kernel, & - brlx, arlx, & + brlx, arlx, ssh_stress, & advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & e_ratio, Ktens, Cf, basalstress, & @@ -213,7 +216,7 @@ subroutine input_data oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & atm_data_type, ocn_data_type, bgc_data_type, fe_data_type, & - ice_data_type, wave_spec_file, & + ice_data_type, wave_spec_file, restart_coszen, & fyear_init, ycycle, & atm_data_dir, ocn_data_dir, bgc_data_dir, & atm_data_format, ocn_data_format, rotate_wind, & @@ -280,8 +283,10 @@ subroutine input_data grid_type = 'rectangular' ! define rectangular grid internally grid_file = 'unknown_grid_file' gridcpl_file = 'unknown_gridcpl_file' - bathymetry_file = 'unknown_bathymetry_file' - use_bathymetry = .false. + orca_halogrid = .false. ! orca haloed grid + bathymetry_file = 'unknown_bathymetry_file' + bathymetry_format = 'default' + use_bathymetry = .false. kmt_file = 'unknown_kmt_file' version_name = 'unknown_version_name' ncat = 0 ! number of ice thickness categories @@ -325,6 +330,7 @@ subroutine input_data ktherm = 1 ! -1 = OFF, 0 = 0-layer, 1 = BL99, 2 = mushy thermo conduct = 'bubbly' ! 'MU71' or 'bubbly' (Pringle et al 2007) coriolis = 'latitude' ! latitude dependent, or 'constant' + ssh_stress = 'geostrophic' ! 'geostrophic' or 'coupled' kridge = 1 ! -1 = off, 1 = on ktransport = 1 ! -1 = off, 1 = on calc_Tsfc = .true. ! calculate surface temperature @@ -436,6 +442,11 @@ subroutine input_data phi_c_slow_mode = 0.05_dbl_kind ! critical liquid fraction porosity cutoff phi_i_mushy = 0.85_dbl_kind ! liquid fraction of congelation ice + ! shortwave redistribution in the thermodynamics + sw_redist = .false. + sw_frac = 0.9_dbl_kind + sw_dtemp = 0.02_dbl_kind + !----------------------------------------------------------------- ! read from input file !----------------------------------------------------------------- @@ -578,7 +589,9 @@ subroutine input_data call broadcast_scalar(grid_type, master_task) call broadcast_scalar(grid_file, master_task) call broadcast_scalar(gridcpl_file, master_task) + call broadcast_scalar(orca_halogrid, master_task) call broadcast_scalar(bathymetry_file, master_task) + call broadcast_scalar(bathymetry_format, master_task) call broadcast_scalar(use_bathymetry, master_task) call broadcast_scalar(kmt_file, master_task) call broadcast_scalar(kitd, master_task) @@ -612,6 +625,7 @@ subroutine input_data call broadcast_scalar(albedo_type, master_task) call broadcast_scalar(ktherm, master_task) call broadcast_scalar(coriolis, master_task) + call broadcast_scalar(ssh_stress, master_task) call broadcast_scalar(kridge, master_task) call broadcast_scalar(ktransport, master_task) call broadcast_scalar(conduct, master_task) @@ -717,6 +731,9 @@ subroutine input_data call broadcast_scalar(dSdt_slow_mode, master_task) call broadcast_scalar(phi_c_slow_mode, master_task) call broadcast_scalar(phi_i_mushy, master_task) + call broadcast_scalar(sw_redist, master_task) + call broadcast_scalar(sw_frac, master_task) + call broadcast_scalar(sw_dtemp, master_task) #ifdef CESMCOUPLED pointer_file = trim(pointer_file) // trim(inst_suffix) @@ -778,16 +795,6 @@ subroutine input_data abort_list = trim(abort_list)//":1" endif -#ifndef ncdf - if (grid_format /= 'bin' .or. atm_data_format /= 'bin' .or. ocn_data_format /= 'bin') then - if (my_task == master_task) then - write(nu_diag,*) subname//' ERROR: ncdf CPP flag unset, data formats must be bin' - write(nu_diag,*) subname//' ERROR: check grid_format, atm_data_format, ocn_data_format or set ncdf CPP' - endif - abort_list = trim(abort_list)//":2" - endif -#endif - if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then if (my_task == master_task) write(nu_diag,*) subname//' ERROR: invalid advection=',trim(advection) abort_list = trim(abort_list)//":3" @@ -970,6 +977,12 @@ subroutine input_data endif endif !tcraig + if (ktherm == 1 .and. .not.sw_redist) then + if (my_task == master_task) then + write(nu_diag,*) subname//' WARNING: ktherm = 1 and sw_redist = ',sw_redist + write(nu_diag,*) subname//' WARNING: For consistency, set sw_redist = .true.' + endif + endif if (formdrag) then if (trim(atmbndy) == 'constant') then @@ -1083,6 +1096,7 @@ subroutine input_data tmpstr2 = ' bathymetric input data is not used' endif write(nu_diag,1012) ' use_bathymetry = ', use_bathymetry,trim(tmpstr2) + write(nu_diag,*) ' bathymetry_format= ', trim(bathymetry_format) endif write(nu_diag,1022) ' nilyr = ', nilyr, ' number of ice layers (equal thickness)' write(nu_diag,1022) ' nslyr = ', nslyr, ' number of snow layers (equal thickness)' @@ -1153,6 +1167,13 @@ subroutine input_data endif write(nu_diag,*) 'coriolis = ',trim(coriolis),trim(tmpstr2) + if (trim(ssh_stress) == 'geostrophic') then + tmpstr2 = ': from ocean velocity' + elseif (trim(ssh_stress) == 'coupled') then + tmpstr2 = ': from coupled sea surface height gradients' + endif + write(nu_diag,*) 'ssh_stress = ',trim(ssh_stress),trim(tmpstr2) + if (ktransport == 1) then tmpstr2 = ' transport enabled' if (trim(advection) == 'remap') then @@ -1177,8 +1198,8 @@ subroutine input_data write(nu_diag,1007) ' k2 = ', k2, ' free parameter for landfast ice' write(nu_diag,1007) ' alphab = ', alphab, ' factor for landfast ice' write(nu_diag,1007) ' threshold_hw = ', threshold_hw, ' max water depth for grounding ice' - write(nu_diag,1007) ' Ktens = ', Ktens, ' tensile strength factor' endif + write(nu_diag,1007) ' Ktens = ', Ktens, ' tensile strength factor' endif ! kdyn enabled write(nu_diag,*) ' ' @@ -1240,6 +1261,9 @@ subroutine input_data write(nu_diag,1007) ' ksno = ', ksno,' snow thermal conductivity' if (ktherm == 1) & write(nu_diag,*) 'conduct = ', trim(conduct),' ice thermal conductivity' + write(nu_diag,1012) ' sw_redist = ', sw_redist,' redistribute internal shortwave to surface' + write(nu_diag,1002) ' sw_frac = ', sw_frac,' fraction redistributed' + write(nu_diag,1002) ' sw_dtemp = ', sw_dtemp,' temperature difference from freezing to redistribute' if (ktherm == 2) then write(nu_diag,1002) ' a_rapid_mode = ', a_rapid_mode,' brine channel diameter' write(nu_diag,1007) ' Rac_rapid_mode = ', Rac_rapid_mode,' critical Rayleigh number' @@ -1291,12 +1315,12 @@ subroutine input_data write(nu_diag,1012) ' calc_strair = ', calc_strair,' calculate wind stress and speed' write(nu_diag,1012) ' rotate_wind = ', rotate_wind,' rotate wind/stress to computational grid' write(nu_diag,1012) ' formdrag = ', formdrag,' use form drag parameterization' - if (trim(atmbndy) == 'constant') then + if (trim(atmbndy) == 'default') then tmpstr2 = ': stability-based boundary layer' write(nu_diag,1012) ' highfreq = ', highfreq,' high-frequency atmospheric coupling' write(nu_diag,1022) ' natmiter = ', natmiter,' number of atmo boundary layer iterations' write(nu_diag,1006) ' atmiter_conv = ', atmiter_conv,' convergence criterion for ustar' - elseif (trim(atmbndy) == 'default') then + elseif (trim(atmbndy) == 'constant') then tmpstr2 = ': boundary layer uses bulk transfer coefficients' endif write(nu_diag,*) 'atmbndy = ', trim(atmbndy),trim(tmpstr2) @@ -1310,6 +1334,11 @@ subroutine input_data tmpstr2 = ' ocean mixed layer calculation (SST) disabled' endif write(nu_diag,1012) ' oceanmixed_ice = ', oceanmixed_ice,trim(tmpstr2) + if (oceanmixed_ice) then + write(nu_diag,*) ' WARNING: ocean mixed layer ON' + write(nu_diag,*) ' WARNING: will impact ocean forcing interaction' + write(nu_diag,*) ' WARNING: coupled forcing will be modified by mixed layer routine' + endif if (trim(tfrz_option) == 'minus1p8') then tmpstr2 = ': constant ocean freezing temperature (-1.8C)' elseif (trim(tfrz_option) == 'linear_salt') then @@ -1486,6 +1515,8 @@ subroutine input_data endif write(nu_diag,1010) ' close_boundaries = ', & close_boundaries + write(nu_diag,1010) ' orca_halogrid = ', & + orca_halogrid write(nu_diag,1010) ' conserv_check = ', conserv_check @@ -1538,17 +1569,6 @@ subroutine input_data if (restore_ice .or. restore_ocn) & write(nu_diag,1020) ' trestore = ', trestore -#ifdef coupled - if( oceanmixed_ice ) then - write(nu_diag,*) subname//' WARNING ** WARNING ** WARNING ** WARNING ' - write(nu_diag,*) subname//' WARNING: coupled CPP and oceanmixed_ice namelist are BOTH ON' - write(nu_diag,*) subname//' WARNING: Ocean data received from coupler will' - write(nu_diag,*) subname//' WARNING: be altered by mixed layer routine!' - write(nu_diag,*) subname//' WARNING ** WARNING ** WARNING ** WARNING ' - write(nu_diag,*) ' ' - endif -#endif - write(nu_diag,*) ' ' write(nu_diag,'(a30,2f8.2)') 'Diagnostic point 1: lat, lon =', & latpnt(1), lonpnt(1) @@ -1630,7 +1650,8 @@ subroutine input_data wave_spec_type_in = wave_spec_type, & 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) + Pstar_in=Pstar, Cstar_in=Cstar, & + 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, & diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 2f1a1c75b..7a2493d58 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -78,7 +78,8 @@ subroutine prep_radiation (iblk) use ice_flux, only: scale_factor, swvdr, swvdf, swidr, swidf, & alvdr_ai, alvdf_ai, alidr_ai, alidf_ai, & alvdr_init, alvdf_init, alidr_init, alidf_init - use ice_arrays_column, only: fswsfcn, fswintn, fswthrun, & + use ice_arrays_column, only: fswsfcn, fswintn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswpenln, Sswabsn, Iswabsn use ice_state, only: aice, aicen use ice_timers, only: ice_timer_start, ice_timer_stop, timer_sw @@ -130,7 +131,12 @@ subroutine prep_radiation (iblk) alvdr_ai = alvdr_ai(i,j, iblk), alvdf_ai = alvdf_ai(i,j, iblk), & alidr_ai = alidr_ai(i,j, iblk), alidf_ai = alidf_ai(i,j, iblk), & fswsfcn = fswsfcn (i,j, :,iblk), fswintn = fswintn (i,j, :,iblk), & - fswthrun = fswthrun(i,j, :,iblk), fswpenln = fswpenln(i,j,:,:,iblk), & + fswthrun = fswthrun(i,j, :,iblk), & + fswthrun_vdr = fswthrun_vdr(i,j, :,iblk), & + fswthrun_vdf = fswthrun_vdf(i,j, :,iblk), & + fswthrun_idr = fswthrun_idr(i,j, :,iblk), & + fswthrun_idf = fswthrun_idf(i,j, :,iblk), & + fswpenln = fswpenln(i,j,:,:,iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), Iswabsn = Iswabsn (i,j,:,:,iblk)) enddo ! i @@ -157,7 +163,8 @@ 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, fswthrun, Sswabsn, Iswabsn + fswsfcn, fswintn, Sswabsn, Iswabsn, & + 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 use ice_domain, only: blocks_ice @@ -168,8 +175,10 @@ subroutine step_therm1 (dt, iblk) flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & - fswthru, meltt, melts, meltb, congel, snoice, & - flatn_f, fsensn_f, fsurfn_f, fcondtopn_f + 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 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 @@ -302,7 +311,8 @@ subroutine step_therm1 (dt, iblk) enddo endif ! tr_aero - if (tmask(i,j,iblk)) & + if (tmask(i,j,iblk)) then + call icepack_step_therm1(dt=dt, ncat=ncat, & nilyr=nilyr, nslyr=nslyr, & aicen_init = aicen_init (i,j,:,iblk), & @@ -389,6 +399,10 @@ subroutine step_therm1 (dt, iblk) fswsfcn = fswsfcn (i,j,:,iblk), & fswintn = fswintn (i,j,:,iblk), & fswthrun = fswthrun (i,j,:,iblk), & + fswthrun_vdr = fswthrun_vdr (i,j,:,iblk),& + fswthrun_vdf = fswthrun_vdf (i,j,:,iblk),& + fswthrun_idr = fswthrun_idr (i,j,:,iblk),& + fswthrun_idf = fswthrun_idf (i,j,:,iblk),& fswabs = fswabs (i,j, iblk), & flwout = flwout (i,j, iblk), & Sswabsn = Sswabsn (i,j,:,:,iblk), & @@ -405,6 +419,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),& flatn_f = flatn_f (i,j,:,iblk), & fsensn_f = fsensn_f (i,j,:,iblk), & fsurfn_f = fsurfn_f (i,j,:,iblk), & @@ -436,6 +454,21 @@ subroutine step_therm1 (dt, iblk) frz_onset = frz_onset (i,j, iblk), & yday=yday, prescribed_ice=prescribed_ice) + !----------------------------------------------------------------- + ! handle per-category i2x fields, no merging + !----------------------------------------------------------------- + + if (send_i2x_per_cat) then + do n = 1, ncat + ! TODO (mvertens, 2018-12-22): do we need to add the band separated quantities + ! for MOM6 here also? + + fswthrun_ai(i,j,n,iblk) = fswthrun(i,j,n,iblk)*aicen_init(i,j,n,iblk) + enddo ! ncat + endif + + endif + if (tr_iso) then do n = 1, ncat if (vicen(i,j,n,iblk) > puny) & @@ -985,7 +1018,8 @@ end subroutine step_dyn_ridge subroutine step_radiation (dt, iblk) use ice_arrays_column, only: ffracn, dhsn, & - fswsfcn, fswintn, fswthrun, fswpenln, Sswabsn, Iswabsn, & + fswsfcn, fswintn, fswpenln, Sswabsn, Iswabsn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & albicen, albsnon, albpndn, & alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & @@ -1122,7 +1156,12 @@ subroutine step_radiation (dt, iblk) alvdrn =alvdrn (i,j,: ,iblk), alvdfn =alvdfn (i,j,: ,iblk), & alidrn =alidrn (i,j,: ,iblk), alidfn =alidfn (i,j,: ,iblk), & fswsfcn =fswsfcn (i,j,: ,iblk), fswintn =fswintn (i,j,: ,iblk), & - fswthrun =fswthrun (i,j,: ,iblk), fswpenln=fswpenln(i,j,:,:,iblk), & + fswthrun =fswthrun (i,j,: ,iblk), & + fswthrun_vdr =fswthrun_vdr (i,j,: ,iblk), & + fswthrun_vdf =fswthrun_vdf (i,j,: ,iblk), & + fswthrun_idr =fswthrun_idr (i,j,: ,iblk), & + fswthrun_idf =fswthrun_idf (i,j,: ,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn =Sswabsn (i,j,:,:,iblk), Iswabsn =Iswabsn (i,j,:,:,iblk), & albicen =albicen (i,j,: ,iblk), albsnon =albsnon (i,j,: ,iblk), & albpndn =albpndn (i,j,: ,iblk), apeffn =apeffn (i,j,: ,iblk), & diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 index d574ebdfe..a7d186083 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_communicate.F90 @@ -45,6 +45,9 @@ module ice_communicate mpitagHalo = 1, &! MPI tags for various mpitag_gs = 1000 ! communication patterns + logical (log_kind), public :: & + add_mpi_barriers = .false. ! turn on mpi barriers for throttling + !*********************************************************************** contains @@ -98,7 +101,11 @@ subroutine init_communicate(mpicom) master_task = 0 call MPI_COMM_RANK (MPI_COMM_ICE, my_task, ierr) +#if (defined NO_R16) + mpiR16 = MPI_REAL8 +#else mpiR16 = MPI_REAL16 +#endif mpiR8 = MPI_REAL8 mpiR4 = MPI_REAL4 diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 index ba6476904..010a5c8c4 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_gather_scatter.F90 @@ -16,7 +16,8 @@ module ice_gather_scatter use mpi ! MPI Fortran module use ice_kinds_mod - use ice_communicate, only: my_task, mpiR8, mpiR4, mpitag_gs, MPI_COMM_ICE + use ice_communicate, only: my_task, mpiR8, mpiR4, mpitag_gs, MPI_COMM_ICE, & + ice_barrier, add_mpi_barriers use ice_constants, only: spval_dbl, c0, & field_loc_center, field_loc_NEcorner, field_loc_Nface, field_loc_Eface, & field_loc_noupdate, & @@ -233,9 +234,9 @@ subroutine gather_global_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -400,9 +401,9 @@ subroutine gather_global_real(ARRAY_G, ARRAY, dst_task, src_dist) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -567,9 +568,9 @@ subroutine gather_global_int(ARRAY_G, ARRAY, dst_task, src_dist) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -961,9 +962,9 @@ subroutine gather_global_ext_dbl(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1284,9 +1285,9 @@ subroutine gather_global_ext_int(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1607,9 +1608,9 @@ subroutine gather_global_ext_log(ARRAY_G, ARRAY, dst_task, src_dist, spc_val) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -1983,9 +1984,9 @@ subroutine scatter_global_dbl(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -2372,9 +2373,9 @@ subroutine scatter_global_real(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -2761,9 +2762,9 @@ subroutine scatter_global_int(ARRAY, ARRAY_G, src_task, dst_dist, & enddo endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -3093,9 +3094,9 @@ subroutine scatter_global_ext(ARRAY, ARRAY_G, src_task, dst_dist) deallocate(rcv_request, rcv_status) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- @@ -3379,9 +3380,9 @@ subroutine scatter_global_stress(ARRAY, ARRAY_G1, ARRAY_G2, & deallocate(rcv_request, rcv_status) endif -#ifdef gather_scatter_barrier - call MPI_BARRIER(MPI_COMM_ICE, ierr) -#endif + if (add_mpi_barriers) then + call ice_barrier() + endif !----------------------------------------------------------------------- diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 index f85109339..27f66f712 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_reprosum.F90 @@ -39,7 +39,7 @@ MODULE ice_reprosum #ifndef SERIAL_REMOVE_MPI use mpi ! MPI Fortran module #endif -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when shr_kind_i8 is not supported. use ice_kinds_mod, only: r8 => dbl_kind, i8 => int_kind #else @@ -1032,7 +1032,7 @@ subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & #ifdef SERIAL_REMOVE_MPI i8_arr_gsum_level = i8_arr_lsum_level #else -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when i8 is not supported. ! if (detailed_timing) call xicex_timer_start("repro_sum_allr_i4") call mpi_allreduce (i8_arr_lsum_level, i8_arr_gsum_level, & diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 index 2468f485b..c9df264dd 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_communicate.F90 @@ -27,6 +27,9 @@ module ice_communicate my_task, &! MPI task number for this task master_task ! task number of master task + logical (log_kind), public :: & + add_mpi_barriers = .false. ! turn on mpi barriers for throttling + !*********************************************************************** contains @@ -43,12 +46,6 @@ subroutine init_communicate ! !----------------------------------------------------------------------- -#ifdef coupled - use mpi ! MPI Fortran module - - integer (int_kind) :: ierr ! MPI error flag -#endif - character(len=*), parameter :: subname = '(init_communicate)' !----------------------------------------------------------------------- @@ -58,27 +55,9 @@ subroutine init_communicate ! !----------------------------------------------------------------------- -#ifdef coupled - call MPI_INIT(ierr) - call MPI_COMM_RANK (MPI_COMM_ICE, my_task, ierr) -#else my_task = 0 -#endif - master_task = 0 -#ifdef coupled -!----------------------------------------------------------------------- -! -! On some 64-bit machines where real_kind and dbl_kind are -! identical, the MPI implementation uses MPI_REAL for both. -! In these cases, set MPI_DBL to MPI_REAL. -! -!----------------------------------------------------------------------- - - MPI_DBL = MPI_DOUBLE_PRECISION - -#endif !----------------------------------------------------------------------- end subroutine init_communicate @@ -136,11 +115,6 @@ subroutine create_communicator(new_comm, num_procs) ! this routine should be called from init_domain1 when the ! domain configuration (e.g. nprocs_btrop) has been determined -#ifdef coupled - - use mpi ! MPI Fortran module - -#endif ! !INPUT PARAMETERS: integer (int_kind), intent(in) :: & @@ -151,54 +125,8 @@ subroutine create_communicator(new_comm, num_procs) integer (int_kind), intent(out) :: & new_comm ! new communicator for this distribution -#ifdef coupled -!----------------------------------------------------------------------- -! -! local variables -! -!----------------------------------------------------------------------- - - integer (int_kind) :: & - MPI_GROUP_ICE, &! group of processors assigned to ice - MPI_GROUP_NEW ! group of processors assigned to new dist - - integer (int_kind) :: & - ierr ! error flag for MPI comms - - integer (int_kind), dimension(3) :: & - range ! range of tasks assigned to new dist - ! (assumed 0,num_procs-1) - - character(len=*), parameter :: subname = '(create_communicator)' - -!----------------------------------------------------------------------- -! -! determine group of processes assigned to distribution -! -!----------------------------------------------------------------------- - - call MPI_COMM_GROUP (MPI_COMM_ICE, MPI_GROUP_ICE, ierr) - - range(1) = 0 - range(2) = num_procs-1 - range(3) = 1 - -!----------------------------------------------------------------------- -! -! create subroup and communicator for new distribution -! note: MPI_COMM_CREATE must be called by all procs in MPI_COMM_ICE -! -!----------------------------------------------------------------------- - - call MPI_GROUP_RANGE_INCL(MPI_GROUP_ICE, 1, range, & - MPI_GROUP_NEW, ierr) - - call MPI_COMM_CREATE (MPI_COMM_ICE, MPI_GROUP_NEW, & - new_comm, ierr) - -#else new_comm = MPI_COMM_ICE -#endif + !----------------------------------------------------------------------- end subroutine create_communicator diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 index ec852e2c3..1e4307535 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_reprosum.F90 @@ -40,7 +40,7 @@ MODULE ice_reprosum #ifndef SERIAL_REMOVE_MPI use mpi ! MPI Fortran module #endif -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when shr_kind_i8 is not supported. use ice_kinds_mod, only: r8 => dbl_kind, i8 => int_kind #else @@ -1033,7 +1033,7 @@ subroutine ice_reprosum_int (arr, arr_gsum, nsummands, dsummands, nflds, & #ifdef SERIAL_REMOVE_MPI i8_arr_gsum_level = i8_arr_lsum_level #else -#if ( defined noI8 ) +#if defined (NO_I8) ! Workaround for when i8 is not supported. ! if (detailed_timing) call xicex_timer_start("repro_sum_allr_i4") call mpi_allreduce (i8_arr_lsum_level, i8_arr_gsum_level, & diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index 3916039b5..cc57ea585 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module ice_domain @@ -14,7 +17,8 @@ module ice_domain use ice_kinds_mod use ice_constants, only: shlat, nhlat - use ice_communicate, only: my_task, master_task, get_num_procs + use ice_communicate, only: my_task, master_task, get_num_procs, & + add_mpi_barriers use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_blocks, only: block, get_block, create_blocks, nghost, & nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block @@ -26,7 +30,7 @@ module ice_domain use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -58,7 +62,8 @@ module ice_domain logical (kind=log_kind), public :: & maskhalo_dyn , & ! if true, use masked halo updates for dynamics maskhalo_remap , & ! if true, use masked halo updates for transport - maskhalo_bound ! if true, use masked halo updates for bound_state + maskhalo_bound , & ! if true, use masked halo updates for bound_state + orca_halogrid ! if true, input fields are haloed as defined by orca grid !----------------------------------------------------------------------- ! @@ -128,7 +133,8 @@ subroutine init_domain_blocks ns_boundary_type, & maskhalo_dyn, & maskhalo_remap, & - maskhalo_bound + maskhalo_bound, & + add_mpi_barriers !---------------------------------------------------------------------- ! @@ -146,6 +152,7 @@ subroutine init_domain_blocks maskhalo_dyn = .false. ! if true, use masked halos for dynamics maskhalo_remap = .false. ! if true, use masked halos for transport maskhalo_bound = .false. ! if true, use masked halos for bound_state + add_mpi_barriers = .false. ! if true, throttle communication max_blocks = -1 ! max number of blocks per processor block_size_x = -1 ! size of block in first horiz dimension block_size_y = -1 ! size of block in second horiz dimension @@ -182,6 +189,7 @@ subroutine init_domain_blocks call broadcast_scalar(maskhalo_dyn, master_task) call broadcast_scalar(maskhalo_remap, master_task) call broadcast_scalar(maskhalo_bound, master_task) + call broadcast_scalar(add_mpi_barriers, master_task) if (my_task == master_task) then if (max_blocks < 1) then max_blocks=int( & @@ -259,6 +267,7 @@ subroutine init_domain_blocks write(nu_diag,'(a,l6)') ' maskhalo_dyn = ', maskhalo_dyn write(nu_diag,'(a,l6)') ' maskhalo_remap = ', maskhalo_remap write(nu_diag,'(a,l6)') ' maskhalo_bound = ', maskhalo_bound + write(nu_diag,'(a,l6)') ' add_mpi_barriers = ', add_mpi_barriers write(nu_diag,'(a,2i6)') ' block_size_x,_y = ', block_size_x, block_size_y write(nu_diag,'(a,i6)') ' max_blocks = ', max_blocks write(nu_diag,'(a,i6,/)')' Number of ghost cells = ', nghost @@ -303,7 +312,7 @@ subroutine init_domain_distribution(KMTG,ULATG) i,j,n ,&! dummy loop indices ig,jg ,&! global indices work_unit ,&! size of quantized work unit -#ifdef ncdf +#ifdef USE_NETCDF fid ,&! file id varid ,&! var id status ,&! netcdf return code @@ -439,7 +448,7 @@ subroutine init_domain_distribution(KMTG,ULATG) allocate(wght(nx_global,ny_global)) if (my_task == master_task) then ! cannot use ice_read_write due to circular dependency -#ifdef ncdf +#ifdef USE_NETCDF write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then @@ -449,7 +458,8 @@ subroutine init_domain_distribution(KMTG,ULATG) status = nf90_get_var(fid, varid, wght) status = nf90_close(fid) #else - call abort_ice (subname//'ERROR: distribution_wght file needs ncdf cpp ') + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif endif call broadcast_array(wght, master_task) diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index f4b5fef6e..34b37cf29 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Spatial grids, masks, and boundary conditions @@ -45,6 +48,7 @@ module ice_grid grid_file , & ! input file for POP grid info kmt_file , & ! input file for POP grid info bathymetry_file, & ! input bathymetry for basalstress + bathymetry_format, & ! bathymetry file format (default or pop) grid_spacing , & ! default of 30.e3m or set by user in namelist grid_type ! current options are rectangular (default), ! displaced_pole, tripole, regional @@ -541,11 +545,14 @@ subroutine init_grid2 ! bathymetry !----------------------------------------------------------------- -#ifdef RASM_MODS - call get_bathymetry_popfile -#else - call get_bathymetry -#endif + if (trim(bathymetry_format) == 'default') then + call get_bathymetry + elseif (trim(bathymetry_format) == 'pop') then + call get_bathymetry_popfile + else + call abort_ice(subname//'ERROR: bathymetry_format value must be default or pop', & + file=__FILE__, line=__LINE__) + endif !---------------------------------------------------------------- ! Corner coordinates for CF compliant history files @@ -713,13 +720,14 @@ end subroutine popgrid subroutine popgrid_nc -#ifdef ncdf use ice_blocks, only: nx_block, ny_block use ice_constants, only: c0, c1, & field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_angle use ice_domain_size, only: max_blocks +#ifdef USE_NETCDF use netcdf +#endif integer (kind=int_kind) :: & i, j, iblk, & @@ -752,6 +760,7 @@ subroutine popgrid_nc character(len=*), parameter :: subname = '(popgrid_nc)' +#ifdef USE_NETCDF call icepack_query_parameters(pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -866,7 +875,11 @@ subroutine popgrid_nc call ice_close_nc(fid_grid) call ice_close_nc(fid_kmt) endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine popgrid_nc #ifdef CESMCOUPLED @@ -879,13 +892,14 @@ end subroutine popgrid_nc subroutine latlongrid -#ifdef ncdf ! use ice_boundary use ice_domain_size use ice_scam, only : scmlat, scmlon, single_column use ice_constants, only: c0, c1, p5, p25, & field_loc_center, field_type_scalar, radius +#ifdef USE_NETCDF use netcdf +#endif integer (kind=int_kind) :: & i, j, iblk @@ -927,6 +941,7 @@ subroutine latlongrid character(len=*), parameter :: subname = '(lonlatgrid)' +#ifdef USE_NETCDF !----------------------------------------------------------------- ! - kmt file is actually clm fractional land file ! - Determine consistency of dimensions @@ -1139,6 +1154,9 @@ subroutine latlongrid !$OMP END PARALLEL DO call makemask +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine latlongrid @@ -2510,11 +2528,9 @@ subroutine read_basalstress_bathy character(len=*), parameter :: subname = '(read_basalstress_bathy)' if (my_task == master_task) then - write (nu_diag,*) ' ' write (nu_diag,*) 'Bathymetry file: ', trim(bathymetry_file) call icepack_warnings_flush(nu_diag) - endif call ice_open_nc(bathymetry_file,fid_init) diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index f497db49b..87d0813cc 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Routines for opening, reading and writing external files @@ -15,13 +18,13 @@ module ice_read_write field_loc_noupdate, field_type_noupdate use ice_communicate, only: my_task, master_task use ice_broadcast, only: broadcast_scalar - use ice_domain, only: distrb_info + use ice_domain, only: distrb_info, orca_halogrid use ice_domain_size, only: max_blocks, nx_global, ny_global, ncat use ice_blocks, only: nx_block, ny_block, nghost use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag -#ifdef ncdf +#ifdef USE_NETCDF use netcdf #endif @@ -1044,7 +1047,7 @@ subroutine ice_open_nc(filename, fid) character(len=*), parameter :: subname = '(ice_open_nc)' -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & status ! status variable from netCDF routine @@ -1058,6 +1061,8 @@ subroutine ice_open_nc(filename, fid) endif ! my_task = master_task #else + 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 @@ -1101,7 +1106,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xy)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid , & ! variable id @@ -1121,18 +1126,17 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + if (orca_halogrid .and. .not. present(restart_ext)) then if (my_task == master_task) then allocate(work_g2(nx_global+2,ny_global+1)) else allocate(work_g2(1,1)) ! to save memory endif + work_g2(:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1166,22 +1170,16 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,nrec/), & - count=(/nx,ny,1/) ) -#else - if (.not. present(restart_ext)) then + 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/) ) 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,nrec/), & + count=(/nx,ny,1/) ) endif -#endif endif ! my_task = master_task @@ -1225,11 +1223,11 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & endif deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + 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__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xy @@ -1273,7 +1271,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xyz)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & n, & ! ncat index @@ -1294,18 +1292,17 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + 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)) else allocate(work_g2(1,1,ncat)) ! to save memory endif + work_g2(:,:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1339,12 +1336,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,ncat,1/) ) -#else - if (.not. present(restart_ext)) then + 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/) ) @@ -1354,7 +1346,6 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & start=(/1,1,1,nrec/), & count=(/nx,ny,ncat,1/) ) endif -#endif endif ! my_task = master_task @@ -1407,11 +1398,11 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & endif deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + 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__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xyz @@ -1458,7 +1449,6 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ! local variables -#ifdef ncdf ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! variable id @@ -1480,18 +1470,20 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & integer (kind=int_kind) :: nx, ny -#ifdef ORCA_GRID + character(len=*), parameter :: subname = '(ice_read_nc_xyf)' + +#ifdef USE_NETCDF real (kind=dbl_kind), dimension(:,:,:), allocatable :: & work_g2 - if (.not. present(restart_ext)) then + 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)) else allocate(work_g2(1,1,nfreq)) ! to save memory endif + work_g2(:,:,:) = c0 endif -#endif nx = nx_global ny = ny_global @@ -1526,13 +1518,7 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g1, & - start=(/1,1,1,nrec/), & - count=(/nx,ny,nfreq,1/) ) -#else - print *, 'restart_ext',restart_ext - if (.not. present(restart_ext)) then + 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/) ) @@ -1542,8 +1528,6 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & start=(/1,1,1,nrec/), & count=(/nx,ny,nfreq,1/) ) endif - print *, 'fid',fid ,' varid',varid -#endif status = nf90_get_att(fid, varid, "missing_value", missingvalue) endif ! my_task = master_task @@ -1601,11 +1585,11 @@ subroutine ice_read_nc_xyf(fid, nrec, varname, work, diag, & where (work > 1.0e+30_dbl_kind) work = c0 deallocate(work_g1) -#ifdef ORCA_GRID - if (.not. present(restart_ext)) deallocate(work_g2) -#endif + 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__) work = c0 ! to satisfy intent(out) attribute #endif @@ -1640,7 +1624,7 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_point)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -1699,6 +1683,8 @@ subroutine ice_read_nc_point(fid, nrec, varname, work, diag, & work = workg(1) #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_point @@ -1731,7 +1717,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & ! local variables -#ifdef ncdf +#ifdef USE_NETCDF real (kind=dbl_kind), dimension(:), allocatable :: & work_z @@ -1749,7 +1735,7 @@ subroutine ice_read_nc_z(fid, nrec, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_z)' -#ifdef ncdf +#ifdef USE_NETCDF allocate(work_z(nilyr)) @@ -1795,6 +1781,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__) work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_z @@ -1831,7 +1819,7 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xy)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & status ! status output from netcdf routines @@ -1915,7 +1903,11 @@ subroutine ice_write_nc_xy(fid, nrec, varid, work, diag, & deallocate(work_g1) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine ice_write_nc_xy !======================================================================= @@ -1950,7 +1942,7 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_xyz)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & n, & ! ncat index @@ -2045,7 +2037,11 @@ subroutine ice_write_nc_xyz(fid, nrec, varid, work, diag, & deallocate(work_g1) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif + end subroutine ice_write_nc_xyz !======================================================================= @@ -2076,7 +2072,7 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) character(len=*), parameter :: subname = '(ice_read_global_nc)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -2091,18 +2087,18 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) ! character (char_len) :: & ! dimname ! dimension name ! -#ifdef ORCA_GRID real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g3 - if (my_task == master_task) then - allocate(work_g3(nx_global+2,ny_global+1)) - else - allocate(work_g3(1,1)) ! to save memory - endif + if (orca_halogrid) then + if (my_task == master_task) then + allocate(work_g3(nx_global+2,ny_global+1)) + else + allocate(work_g3(1,1)) ! to save memory + endif + work_g3(:,:) = c0 + endif - work_g3(:,:) = c0 -#endif work_g(:,:) = c0 if (my_task == master_task) then @@ -2121,16 +2117,16 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) ! Read global array !-------------------------------------------------------------- -#ifndef ORCA_GRID - status = nf90_get_var( fid, varid, work_g, & - start=(/1,1,nrec/), & - count=(/nx_global,ny_global,1/) ) -#else - status = nf90_get_var( fid, varid, work_g3, & - start=(/1,1,nrec/), & - count=(/nx_global+2,ny_global+1,1/) ) - work_g=work_g3(2:nx_global+1,1:ny_global) -#endif + if (orca_halogrid) then + status = nf90_get_var( fid, varid, work_g3, & + start=(/1,1,nrec/), & + count=(/nx_global+2,ny_global+1,1/) ) + 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/) ) + endif endif ! my_task = master_task !------------------------------------------------------------------- @@ -2153,13 +2149,14 @@ subroutine ice_read_global_nc (fid, nrec, varname, work_g, diag) write(nu_diag,*) 'min, max, sum = ', amin, amax, asum, trim(varname) endif -#ifdef ORCA_GRID - deallocate(work_g3) -#endif + if (orca_halogrid) deallocate(work_g3) #else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_global_nc !======================================================================= @@ -2176,13 +2173,16 @@ subroutine ice_close_nc(fid) character(len=*), parameter :: subname = '(ice_close_nc)' -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & status ! status variable from netCDF routine if (my_task == master_task) then status = nf90_close(fid) endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_close_nc @@ -2227,7 +2227,7 @@ subroutine ice_read_nc_uv(fid, nrec, nzlev, varname, work, diag, & character(len=*), parameter :: subname = '(ice_read_nc_uv)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid , & ! variable id @@ -2318,8 +2318,11 @@ 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__) work = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_nc_uv !======================================================================= @@ -2350,7 +2353,7 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) character(len=*), parameter :: subname = '(ice_read_vec_nc)' -#ifdef ncdf +#ifdef USE_NETCDF ! netCDF file diagnostics: integer (kind=int_kind) :: & varid, & ! netcdf id for field @@ -2393,9 +2396,11 @@ subroutine ice_read_vec_nc (fid, nrec, varname, work_g, diag) endif #else - write(*,*) 'ERROR: ncdf not defined during compilation' + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) work_g = c0 ! to satisfy intent(out) attribute #endif + end subroutine ice_read_vec_nc !======================================================================= @@ -2411,7 +2416,7 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) ! local variables -#ifdef ncdf +#ifdef USE_NETCDF integer (kind=int_kind) :: & ndims, i, status character (char_len) :: & @@ -2419,7 +2424,7 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) #endif character(len=*), parameter :: subname = '(ice_get_ncvarsize)' -#ifdef ncdf +#ifdef USE_NETCDF if (my_task == master_task) then status=nf90_inquire(fid, nDimensions = nDims) if (status /= nf90_noerr) then @@ -2437,9 +2442,11 @@ subroutine ice_get_ncvarsize(fid,varname,recsize) endif endif #else - write(*,*) 'ERROR: ncdf not defined during compilation' + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) recsize = 0 ! to satisfy intent(out) attribute #endif + end subroutine ice_get_ncvarsize !======================================================================= 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 5b6aa0dd8..b3024302e 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! ! Writes history in netCDF format @@ -41,7 +44,6 @@ module ice_history_write subroutine ice_write_hist (ns) use ice_kinds_mod -#ifdef ncdf use ice_arrays_column, only: hin_max, floe_rad_c use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar @@ -56,6 +58,7 @@ subroutine ice_write_hist (ns) lont_bounds, latt_bounds, lonu_bounds, latu_bounds use ice_history_shared use ice_restart_shared, only: runid, lcdf64 +#ifdef USE_NETCDF use netcdf #endif @@ -63,7 +66,6 @@ subroutine ice_write_hist (ns) ! local variables -#ifdef ncdf real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 real (kind=real_kind), dimension(:,:), allocatable :: work_gr real (kind=real_kind), dimension(:,:,:), allocatable :: work_gr3 @@ -120,6 +122,7 @@ subroutine ice_write_hist (ns) character(len=*), parameter :: subname = '(ice_write_hist)' +#ifdef USE_NETCDF call icepack_query_parameters(secday_out=secday, rad_to_deg_out=rad_to_deg) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1571,6 +1574,10 @@ subroutine ice_write_hist (ns) write(nu_diag,*) ' ' write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif + +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) #endif end subroutine ice_write_hist diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index 8bb09398e..53c7dac60 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -1,3 +1,6 @@ +#ifdef ncdf +#define USE_NETCDF +#endif !======================================================================= ! Read and write ice model restart files using netCDF or binary @@ -8,7 +11,9 @@ module ice_restart use ice_broadcast use ice_kinds_mod +#ifdef USE_NETCDF use netcdf +#endif use ice_restart_shared, only: & restart_ext, restart_dir, restart_file, pointer_file, & runid, use_restart_time, lcdf64, lenstr, restart_coszen @@ -52,6 +57,7 @@ subroutine init_restart_read(ice_ic) character(len=*), parameter :: subname = '(init_restart_read)' +#ifdef USE_NETCDF if (present(ice_ic)) then filename = trim(ice_ic) else @@ -97,6 +103,10 @@ subroutine init_restart_read(ice_ic) if (trim(runid) == 'bering') then npt = npt - istep0 endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(ice_ic), & + file=__FILE__, line=__LINE__) +#endif end subroutine init_restart_read @@ -153,6 +163,7 @@ subroutine init_restart_write(filename_spec) character(len=*), parameter :: subname = '(init_restart_write)' +#ifdef USE_NETCDF call icepack_query_parameters( & solve_zsal_out=solve_zsal, skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_query_tracer_sizes( & @@ -619,6 +630,11 @@ subroutine init_restart_write(filename_spec) write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif ! master_task +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined for '//trim(filename_spec), & + file=__FILE__, line=__LINE__) +#endif + end subroutine init_restart_write !======================================================================= @@ -661,6 +677,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & character(len=*), parameter :: subname = '(read_restart_field)' +#ifdef USE_NETCDF if (present(field_loc)) then if (ndim3 == ncat) then if (restart_ext) then @@ -699,6 +716,11 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3, & endif endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine read_restart_field !======================================================================= @@ -740,6 +762,7 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) character(len=*), parameter :: subname = '(write_restart_field)' +#ifdef USE_NETCDF status = nf90_inq_varid(ncid,trim(vname),varid) if (ndim3 == ncat) then if (restart_ext) then @@ -758,6 +781,11 @@ subroutine write_restart_field(nu,nrec,work,atype,vname,ndim3,diag) write(nu_diag,*) 'ndim3 not supported',ndim3 endif +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine write_restart_field !======================================================================= @@ -774,11 +802,17 @@ subroutine final_restart() character(len=*), parameter :: subname = '(final_restart)' +#ifdef USE_NETCDF status = nf90_close(ncid) if (my_task == master_task) & write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif + end subroutine final_restart !======================================================================= @@ -799,7 +833,12 @@ subroutine define_rest_field(ncid, vname, dims) character(len=*), parameter :: subname = '(define_rest_field)' +#ifdef USE_NETCDF status = nf90_def_var(ncid,trim(vname),nf90_double,dims,varid) +#else + call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & + file=__FILE__, line=__LINE__) +#endif end subroutine define_rest_field 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 d030b439b..7e16f2591 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -39,7 +39,6 @@ module ice_history_write subroutine ice_write_hist (ns) -#ifdef ncdf use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar use ice_calendar, only: time, sec, idate, idate0, write_ic, & @@ -55,8 +54,6 @@ subroutine ice_write_hist (ns) use ice_history_shared use ice_arrays_column, only: hin_max, floe_rad_c use ice_restart_shared, only: runid, lcdf64 - use netcdf -#endif use ice_pio use pio @@ -64,7 +61,6 @@ subroutine ice_write_hist (ns) ! local variables -#ifdef ncdf integer (kind=int_kind) :: i,j,k,ic,n,nn, & ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid, & length,nvertexid,ivertex,kmtida,fmtid @@ -1300,8 +1296,6 @@ subroutine ice_write_hist (ns) write(nu_diag,*) 'Finished writing ',trim(ncfile(ns)) endif -#endif - end subroutine ice_write_hist !======================================================================= diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index b11dcf0d0..eb703abcd 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -662,7 +662,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & use ice_global_reductions, only: global_minval, global_maxval, global_sum integer (kind=int_kind), intent(in) :: & - nu , & ! unit number (not used for netcdf) + nu , & ! unit number ndim3 , & ! third dimension nrec ! record number (0 for sequential access) diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index b38c1aa29..72bf1b747 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -56,7 +55,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 index 6b5a53abe..397950023 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 @@ -58,9 +58,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index b208bcbef..dc41ff9fd 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_fsd, wave_spec @@ -131,9 +128,6 @@ subroutine cice_init endif call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -202,19 +196,17 @@ subroutine cice_init call init_forcing_atmo ! initialize atmospheric forcing (standalone) #endif -#ifndef coupled -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif +! standalone +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data + +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry + if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 index 90af92122..e43b4a24d 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 @@ -92,21 +92,19 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED +! standalone ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values + +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! initialize atmosphere fluxes sent to coupler diff --git a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 index c2331e4e5..943787498 100644 --- a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 @@ -55,9 +55,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index b72745e30..80bb2570e 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init(mpicom_ice) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpicom_ice ! communicator for sequential ccsm @@ -134,9 +131,6 @@ subroutine cice_init(mpicom_ice) call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -206,21 +200,19 @@ subroutine cice_init(mpicom_ice) call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled -#ifndef CESMCOUPLED - if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! for standalone +! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data + +! ! isotopes +! if (tr_iso) call fiso_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index f5e7de02f..ee217712b 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -89,23 +89,20 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED +! for standalone ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data +! call get_forcing_atmo ! atmospheric forcing from data +! call get_forcing_ocn(dt) ! ocean forcing from data - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values +! ! isotopes +! if (tr_iso) call fiso_default ! default values +! ! aerosols +! ! if (tr_aero) call faero_data ! data file +! ! if (tr_zaero) call fzaero_data ! data file (gx1) +! if (tr_aero .or. tr_zaero) call faero_default ! default values +! if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler diff --git a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 index c2331e4e5..943787498 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 @@ -55,9 +55,8 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled - call end_run ! quit MPI -#endif +! standalone +! call end_run ! quit MPI end subroutine CICE_Finalize diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 486c36dcc..644ef72fa 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -346,6 +346,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind @@ -543,7 +544,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index aff4b5099..da3d95369 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -86,7 +86,7 @@ module ice_comp_nuopc character(len=*),parameter :: shr_cal_noleap = 'NO_LEAP' character(len=*),parameter :: shr_cal_gregorian = 'GREGORIAN' - integer , parameter :: dbug = 10 + integer :: dbug = 0 integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level character(*), parameter :: modName = "(ice_comp_nuopc)" @@ -236,6 +236,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dbug + end if + write(logmsg,'(i6)') dbug + call ESMF_LogWrite('CICE_cap: dbug = '//trim(logmsg), ESMF_LOGMSG_INFO) + call ice_advertise_fields(gcomp, importState, exportState, flds_scalar_name, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -539,6 +547,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call icepack_query_parameters(ktherm_out=ktherm) + call icepack_query_parameters(tfrz_option_out=tfrz_option) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) @@ -602,6 +611,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif +#ifdef CESMCOUPLED if (calendar_type == "GREGORIAN" .or. & calendar_type == "Gregorian" .or. & calendar_type == "gregorian") then @@ -609,6 +619,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call time2sec(iyear-year_init,month,mday,time) endif +#endif time = time+start_tod end if @@ -874,8 +885,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! diagnostics !-------------------------------- - if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) + if (dbug > 0) then + call state_diagnose(exportState,subname//':ES',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -905,8 +916,10 @@ subroutine ModelAdvance(gcomp, rc) ! Local variables type(ESMF_Clock) :: clock type(ESMF_Alarm) :: alarm + type(ESMF_Time) :: startTime type(ESMF_Time) :: currTime type(ESMF_Time) :: nextTime + type(ESMF_TimeInterval) :: timeStep type(ESMF_State) :: importState, exportState character(ESMF_MAXSTR) :: cvalue real(dbl_kind) :: eccen, obliqr, lambm0, mvelpp @@ -928,11 +941,31 @@ subroutine ModelAdvance(gcomp, rc) logical :: isPresent, isSet character(*) , parameter :: F00 = "('(ice_comp_nuopc) ',2a,i8,d21.14)" character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' + character(char_len_long) :: msgString !-------------------------------- rc = ESMF_SUCCESS if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing ICE from: ", unit=msgString, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//trim(msgString), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, & + timeStep=timeStep, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", unit=msgString, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + !-------------------------------- ! Turn on timers !-------------------------------- @@ -1050,6 +1083,10 @@ subroutine ModelAdvance(gcomp, rc) idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (dbug > 0) then + call state_diagnose(importState,subname//':IS',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if !-------------------------------- ! Advance cice and timestep update @@ -1067,11 +1104,16 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf ('cice_run_export') + ! write Debug output if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & idate, sec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (dbug > 0) then + call state_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! reset shr logging to my original values call shr_file_setLogUnit (shrlogunit) diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 9adb868db..b32085143 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -13,13 +13,11 @@ module ice_import_export use ice_flux , only : strairxt, strairyt, strocnxt, strocnyt use ice_flux , only : alvdr, alidr, alvdf, alidf, Tref, Qref, Uref use ice_flux , only : flat, fsens, flwout, evap, fswabs, fhocn, fswthru -#if (defined NEWCODE) - use ice_flux , only : fswthruvdr, fswthruvdf, fswthruidr, fswthruidf + use ice_flux , only : fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf use ice_flux , only : send_i2x_per_cat, fswthrun_ai - use ice_flux , only : faero_atm, faero_ocn - use ice_flux , only : fiso_atm, fiso_ocn, fiso_rain, fiso_evap - use ice_flux , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn -#endif + use ice_flux_bgc , only : faero_atm, faero_ocn + use ice_flux_bgc , only : fiso_atm, fiso_ocn, fiso_evap + use ice_flux_bgc , only : Qa_iso, Qref_iso, HDO_ocn, H2_18O_ocn, H2_16O_ocn use ice_flux , only : fresh, fsalt, zlvl, uatm, vatm, potT, Tair, Qa use ice_flux , only : rhoa, swvdr, swvdf, swidr, swidf, flw, frain use ice_flux , only : fsnow, uocn, vocn, sst, ss_tltx, ss_tlty, frzmlt @@ -35,6 +33,7 @@ module ice_import_export use icepack_intfc , only : icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc , only : icepack_query_parameters, icepack_query_tracer_flags use icepack_intfc , only : icepack_liquidus_temperature + use icepack_intfc , only : icepack_sea_freezing_temperature use cice_wrapper_mod , only : t_startf, t_stopf, t_barrierf #ifdef CESMCOUPLED use shr_frz_mod , only : shr_frz_freezetemp @@ -87,7 +86,7 @@ module ice_import_export type (fld_list_type) :: fldsFrIce(fldsMax) type(ESMF_GeomType_Flag) :: geomtype - integer , parameter :: dbug = 10 ! i/o debug messages + integer , parameter :: io_dbug = 10 ! i/o debug messages character(*), parameter :: u_FILE_u = & __FILE__ @@ -115,7 +114,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Determine if the following attributes are sent by the driver and if so read them in flds_wiso = .false. @@ -126,7 +125,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) end if -#if (defined NEWCODE) flds_i2o_per_cat = .false. call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -134,7 +132,6 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam read(cvalue,*) send_i2x_per_cat call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) end if -#endif !----------------- ! advertise import fields @@ -207,14 +204,12 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_vis_dif_albedo' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'inst_ice_ir_dif_albedo' ) -#if (defined NEWCODE) ! the following are advertised but might not be connected if they are not present ! in the cmeps esmFldsExchange_xxx_mod.F90 that is model specific if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'ice_fraction_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if -#endif ! ice/atm fluxes computed by ice call fldlist_add(fldsFrIce_num, fldsFrIce, 'stress_on_air_ice_zonal' ) @@ -233,12 +228,10 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dir_flx' ) call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ir_dif_flx' ) -#if (defined NEWCODE) if (send_i2x_per_cat) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_sw_pen_to_ocn_ifrac_n', & ungridded_lbound=1, ungridded_ubound=ncat) end if -#endif call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_fresh_water_to_ocean_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'mean_salt_rate' ) call fldlist_add(fldsFrIce_num , fldsFrIce, 'stress_on_ocn_ice_zonal' ) @@ -253,8 +246,8 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (flds_wiso) then call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_fresh_water_to_ocean_rate_wiso', & ungridded_lbound=1, ungridded_ubound=3) - !call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & - ! ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsFrIce_num, fldsFrIce, 'mean_evap_rate_atm_into_ice_wiso', & + ungridded_lbound=1, ungridded_ubound=3) call fldlist_add(fldsFrIce_num, fldsFrIce, 'Si_qref_wiso', & ungridded_lbound=1, ungridded_ubound=3) end if @@ -265,7 +258,7 @@ subroutine ice_advertise_fields(gcomp, importState, exportState, flds_scalar_nam if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ice_advertise_fields @@ -361,12 +354,22 @@ subroutine ice_import( importState, rc ) real (kind=dbl_kind),allocatable :: aflds(:,:,:,:) real (kind=dbl_kind) :: workx, worky real (kind=dbl_kind) :: MIN_RAIN_TEMP, MAX_SNOW_TEMP - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh real (kind=dbl_kind) :: inst_pres_height_lowest + character(len=char_len) :: tfrz_option + integer(int_kind) :: ktherm character(len=*), parameter :: subname = 'ice_import' + character(len=1024) :: msgString !----------------------------------------------------- call icepack_query_parameters(Tffresh_out=Tffresh) + call icepack_query_parameters(tfrz_option_out=tfrz_option) + call icepack_query_parameters(ktherm_out=ktherm) + if (io_dbug > 5) then + write(msgString,'(A,i8)')trim(subname)//' tfrz_option = ' & + // trim(tfrz_option)//', ktherm = ',ktherm + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + end if ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & ! modal_aero_out=modal_aero, z_tracers_out=z_tracers, skl_bgc_out=skl_bgc, & ! Tffresh_out=Tffresh) @@ -568,7 +571,6 @@ subroutine ice_import( importState, rc ) ! Get aerosols from mediator !------------------------------------------------------- -#if (defined NEWCODE) if (State_FldChk(importState, 'Faxa_bcph')) then ! the following indices are based on what the atmosphere is sending ! bcphidry ungridded_index=1 @@ -604,7 +606,6 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'Faxa_dstdry', output=faero_atm, index=3, do_sum=.true., ungridded_index=4, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#endif !------------------------------------------------------- ! Water isotopes from the mediator @@ -614,7 +615,6 @@ subroutine ice_import( importState, rc ) ! 18O => ungridded_index=2 ! HDO => ungridded_index=3 -#if (defined NEWCODE) if (State_FldChk(importState, 'shum_wiso')) then call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -623,12 +623,12 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'inst_spec_humid_height_lowest_wiso', output=Qa_iso, index=3, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=1, ungridded_index=3, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=2, ungridded_index=1, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return +! call state_getimport(importState, 'mean_prec_rate_wiso', output=fiso_rain, index=3, ungridded_index=2, rc=rc) +! if (ChkErr(rc,__LINE__,u_FILE_u)) return call state_getimport(importState, 'mean_fprec_rate_wiso', output=fiso_atm, index=1, ungridded_index=3, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -644,7 +644,6 @@ subroutine ice_import( importState, rc ) call state_getimport(importState, 'So_roce_wiso', output=H2_18O_ocn, ungridded_index=2, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -#endif !----------------------------------------------------------------- ! rotate zonal/meridional vectors to local coordinates @@ -697,8 +696,7 @@ subroutine ice_import( importState, rc ) do iblk = 1, nblocks do j = 1,ny_block do i = 1,nx_block - !TODO: tcx should this be icepack_sea_freezing_temperature? - Tf (i,j,iblk) = icepack_liquidus_temperature(sss(i,j,iblk)) + Tf(i,j,iblk) = icepack_sea_freezing_temperature(sss(i,j,iblk)) end do end do end do @@ -773,12 +771,12 @@ subroutine ice_export( exportState, rc ) real (kind=dbl_kind) :: tauyo (nx_block,ny_block,max_blocks) ! ice/ocean stress real (kind=dbl_kind) :: ailohi(nx_block,ny_block,max_blocks) ! fractional ice area real (kind=dbl_kind), allocatable :: tempfld(:,:,:) - real (kind=dbl_kind) :: tffresh + real (kind=dbl_kind) :: Tffresh character(len=*),parameter :: subname = 'ice_export' !----------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + if (io_dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call icepack_query_parameters(Tffresh_out=Tffresh) ! call icepack_query_parameters(tfrz_option_out=tfrz_option, & @@ -907,7 +905,6 @@ subroutine ice_export( exportState, rc ) ! ---- ! surface temperature of ice covered portion (degK) - !call state_setexport(exportState, 'sea_ice_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) call state_setexport(exportState, 'sea_ice_surface_temperature', input=Tsrf , lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1005,23 +1002,21 @@ subroutine ice_export( exportState, rc ) call state_setexport(exportState, 'mean_sw_pen_to_ocn' , input=fswthru, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#if (defined NEWCODE) ! flux of vis dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthruvdr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dir_flx' , input=fswthru_vdr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of vis dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthruvdf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_vis_dif_flx' , input=fswthru_vdf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dir shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthruidr, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dir_flx' , input=fswthru_idr, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! flux of ir dif shortwave through ice to ocean - call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthruidf, lmask=tmask, ifrac=ailohi, rc=rc) + call state_setexport(exportState, 'mean_sw_pen_to_ocn_ir_dif_flx' , input=fswthru_idf, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif ! heat exchange with ocean call state_setexport(exportState, 'net_heat_flx_to_ocn' , input=fhocn, lmask=tmask, ifrac=ailohi, rc=rc) @@ -1043,7 +1038,6 @@ subroutine ice_export( exportState, rc ) call state_setexport(exportState, 'stress_on_ocn_ice_merid' , input=tauyo, lmask=tmask, ifrac=ailohi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -#if (defined NEWCODE) ! ------ ! optional aerosol fluxes to ocean ! ------ @@ -1134,7 +1128,6 @@ subroutine ice_export( exportState, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if -#endif end subroutine ice_export diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 56dffc6b7..ec1963d38 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -57,7 +56,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index adafb3d36..4e236bb11 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -92,9 +92,6 @@ subroutine cice_init(mpi_comm) use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif integer (kind=int_kind), optional, intent(in) :: & mpi_comm ! communicator for sequential ccsm @@ -146,9 +143,6 @@ subroutine cice_init(mpi_comm) call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 56dffc6b7..ec1963d38 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -17,7 +17,6 @@ ! https://github.com/CICE-Consortium ! !======================================================================= -#ifndef popcice ! ! Main driver routine for CICE. Initializes and steps through the model. ! This program should be compiled if CICE is run as a separate executable, @@ -57,7 +56,6 @@ program icemodel end program icemodel -#endif !======================================================================= ! ! Wrapper for the print_state debugging routine. diff --git a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 index 0cd1ff177..dd0ca0b20 100644 --- a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 @@ -65,9 +65,7 @@ subroutine CICE_Finalize ! quit MPI !------------------------------------------------------------------- -#ifndef coupled call end_run ! quit MPI -#endif end subroutine CICE_Finalize diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 59bbca31c..0a8614eb2 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -87,9 +87,6 @@ subroutine cice_init use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start use ice_transport_driver, only: init_transport -#ifdef popcice - use drv_forcing, only: sst_sss -#endif logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers, & tr_iso, tr_fsd, wave_spec @@ -134,9 +131,6 @@ subroutine cice_init call init_coupler_flux ! initialize fluxes exchanged with coupler -#ifdef popcice - call sst_sss ! POP data for CICE initialization -#endif call init_thermo_vertical ! initialize vertical thermodynamics call icepack_init_itd(ncat=ncat, hin_max=hin_max) ! ice thickness distribution @@ -206,8 +200,6 @@ subroutine cice_init call init_forcing_atmo ! initialize atmospheric forcing (standalone) -#ifndef coupled -#ifndef CESMCOUPLED if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data call get_forcing_ocn(dt) ! ocean forcing from data @@ -219,8 +211,6 @@ subroutine cice_init ! if (tr_zaero) call fzaero_data ! data file (gx1) if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry if (runtype == 'initial' .and. .not. restart) & diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 7645c43f3..b45db2514 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -94,8 +94,6 @@ subroutine CICE_Run call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data @@ -109,8 +107,6 @@ subroutine CICE_Run if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler @@ -356,7 +352,9 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_ai, fhocn, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + scale_factor, snowfrac, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -550,7 +548,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug index 7ca555433..c7ae7601f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug @@ -94,8 +94,6 @@ call ice_timer_start(timer_couple) ! atm/ocn coupling -#ifndef coupled -#ifndef CESMCOUPLED ! for now, wave_spectrum is constant in time ! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing_atmo ! atmospheric forcing from data @@ -109,8 +107,6 @@ if (tr_aero .or. tr_zaero) call faero_default ! default values if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry -#endif -#endif if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler diff --git a/cicecore/shared/ice_arrays_column.F90 b/cicecore/shared/ice_arrays_column.F90 index 64c4de612..06efd6e94 100644 --- a/cicecore/shared/ice_arrays_column.F90 +++ b/cicecore/shared/ice_arrays_column.F90 @@ -106,6 +106,10 @@ module ice_arrays_column public :: & fswsfcn , & ! SW absorbed at ice/snow surface (W m-2) fswthrun , & ! SW through ice to ocean (W/m^2) + fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) + fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2) + fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2) + fswthrun_idf , & ! nir dif SW through ice to ocean (W/m^2) fswintn ! SW absorbed in ice interior, below surface (W m-2) real (kind=dbl_kind), dimension (:,:,:,:,:), allocatable, & @@ -359,6 +363,10 @@ subroutine alloc_arrays_column snowfracn (nx_block,ny_block,ncat,max_blocks), & ! Category snow fraction used in radiation fswsfcn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed at ice/snow surface (W m-2) fswthrun (nx_block,ny_block,ncat,max_blocks), & ! SW through ice to ocean (W/m^2) + fswthrun_vdr (nx_block,ny_block,ncat,max_blocks), & ! vis dir SW through ice to ocean (W/m^2) + fswthrun_vdf (nx_block,ny_block,ncat,max_blocks), & ! vis dif SW through ice to ocean (W/m^2) + fswthrun_idr (nx_block,ny_block,ncat,max_blocks), & ! nir dir SW through ice to ocean (W/m^2) + fswthrun_idf (nx_block,ny_block,ncat,max_blocks), & ! nir dif SW through ice to ocean (W/m^2) fswintn (nx_block,ny_block,ncat,max_blocks), & ! SW absorbed in ice interior, below surface (W m-2) first_ice_real & (nx_block,ny_block,ncat,max_blocks), & ! .true. = c1, .false. = c0 diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 9e4838087..0370a0d7e 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -181,7 +181,8 @@ end subroutine init_thermo_vertical subroutine init_shortwave use ice_arrays_column, only: fswpenln, Iswabsn, Sswabsn, albicen, & - albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, fswthrun, & + albsnon, alvdrn, alidrn, alvdfn, alidfn, fswsfcn, & + fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf, & fswintn, albpndn, apeffn, trcrn_sw, dhsn, ffracn, snowfracn, & kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, gaer_bc_tab, bcenh, & swgrid, igrid @@ -304,6 +305,10 @@ subroutine init_shortwave fswsfcn(i,j,n,iblk) = c0 fswintn(i,j,n,iblk) = c0 fswthrun(i,j,n,iblk) = c0 + fswthrun_vdr(i,j,n,iblk) = c0 + fswthrun_vdf(i,j,n,iblk) = c0 + fswthrun_idr(i,j,n,iblk) = c0 + fswthrun_idf(i,j,n,iblk) = c0 enddo ! ncat enddo @@ -363,7 +368,12 @@ subroutine init_shortwave alvdrn=alvdrn(i,j,:,iblk), alvdfn=alvdfn(i,j,:,iblk), & alidrn=alidrn(i,j,:,iblk), alidfn=alidfn(i,j,:,iblk), & fswsfcn=fswsfcn(i,j,:,iblk), fswintn=fswintn(i,j,:,iblk), & - fswthrun=fswthrun(i,j,:,iblk), fswpenln=fswpenln(i,j,:,:,iblk), & + fswthrun=fswthrun(i,j,:,iblk), & + fswthrun_vdr=fswthrun_vdr(i,j,:,iblk), & + fswthrun_vdf=fswthrun_vdf(i,j,:,iblk), & + fswthrun_idr=fswthrun_idr(i,j,:,iblk), & + fswthrun_idf=fswthrun_idf(i,j,:,iblk), & + fswpenln=fswpenln(i,j,:,:,iblk), & Sswabsn=Sswabsn(i,j,:,:,iblk), Iswabsn=Iswabsn(i,j,:,:,iblk), & albicen=albicen(i,j,:,iblk), albsnon=albsnon(i,j,:,iblk), & albpndn=albpndn(i,j,:,iblk), apeffn=apeffn(i,j,:,iblk), & diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index b51484201..b9aed44fe 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -117,10 +117,10 @@ cd ${ICE_OBJDIR} if (${ICE_IOTYPE} == 'netcdf') then set IODIR = io_netcdf - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else if (${ICE_IOTYPE} =~ pio*) then set IODIR = io_pio2 - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else set IODIR = io_binary endif diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index a408cc7d2..ea38e048b 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -57,10 +57,10 @@ if !($?IO_TYPE) then endif if ($IO_TYPE == 'netcdf3' || $IO_TYPE == 'netcdf4') then setenv IODIR io_netcdf - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else if ($IO_TYPE == 'pio') then setenv IODIR io_pio - setenv ICE_CPPDEFS "${ICE_CPPDEFS} -Dncdf" + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" else setenv IODIR io_binary endif diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index 54663f86c..a26579df1 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -10,7 +10,6 @@ ice_ic = './restart/iced_gx3_v5.nc' restart = .true. restart_ext = .false. - restart_coszen = .false. use_restart_time = .true. restart_format = 'default' lcdf64 = .false. @@ -53,6 +52,7 @@ grid_file = 'grid' kmt_file = 'kmt' bathymetry_file = 'unknown_bathymetry_file' + bathymetry_format = 'default' use_bathymetry = .false. gridcpl_file = 'unknown_gridcpl_file' kcatbound = 0 @@ -64,6 +64,7 @@ nilyr = 7 nslyr = 1 nblyr = 7 + orca_halogrid = .false. / &tracer_nml @@ -107,6 +108,9 @@ dSdt_slow_mode = -5.0e-8 phi_c_slow_mode = 0.05 phi_i_mushy = 0.85 + sw_redist = .false. + sw_frac = 0.9d0 + sw_dtemp = 0.02d0 / &dynamics_nml @@ -134,6 +138,7 @@ coriolis = 'latitude' kridge = 1 ktransport = 1 + ssh_stress = 'geostrophic' / &shortwave_nml @@ -182,6 +187,7 @@ wave_spec_type = 'none' wave_spec_file = 'unknown_wave_spec_file' nfreq = 25 + restart_coszen = .false. restore_ice = .false. restore_ocn = .false. trestore = 90 @@ -217,6 +223,7 @@ maskhalo_dyn = .false. maskhalo_remap = .false. maskhalo_bound = .false. + add_mpi_barriers = .false. / &zbgc_nml diff --git a/configuration/scripts/options/set_nml.alt03 b/configuration/scripts/options/set_nml.alt03 index 43681ab9d..f82491d9d 100644 --- a/configuration/scripts/options/set_nml.alt03 +++ b/configuration/scripts/options/set_nml.alt03 @@ -14,6 +14,9 @@ tr_aero = .true. calc_Tsfc = .false. kdyn = 2 ktherm = 1 +sw_redist = .true. +sw_frac = 0.9d0 +sw_dtemp = 0.02d0 tfrz_option = 'linear_salt' revised_evp = .false. Ktens = 0. diff --git a/configuration/scripts/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index 786decae6..937704294 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -13,6 +13,9 @@ tr_pond_lvl = .true. tr_aero = .true. kitd = 0 ktherm = 1 +sw_redist = .true. +sw_frac = 0.9d0 +sw_dtemp = 0.02d0 conduct = 'MU71' kdyn = 1 kevp_kernel = 102 diff --git a/configuration/scripts/parse_namelist.sh b/configuration/scripts/parse_namelist.sh index c94420f6e..ea539a2d0 100755 --- a/configuration/scripts/parse_namelist.sh +++ b/configuration/scripts/parse_namelist.sh @@ -5,12 +5,15 @@ if [[ "$#" -ne 2 ]]; then exit -1 fi +scriptname=`basename "$0"` filename=$1 filemods=$2 #echo "$0 $1 $2" echo "running parse_namelist.sh" foundstring="FoundSTRING" +vnamearray=() +valuearray=() while read -r line do @@ -24,17 +27,39 @@ do value=`echo $line | sed "s|^[[:space:]]*\([^[:space:]]*\)[[:space:]]*=[[:space:]]*\([^[:space:]]*\).*$|\2|g"` # echo "$line $vname $value" + found=${foundstring} + for i in "${!vnamearray[@]}"; do + if [[ "${found}" == "${foundstring}" ]]; then + vn=${vnamearray[$i]} + vv=${valuearray[$i]} +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + if [[ "$vname" == "$vn" ]]; then + found=$i + if [[ "$value" != "${vv}" ]]; then +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + echo "${scriptname} WARNING: re-overriding $vname from ${vv} to ${value}" + fi + fi + fi + done + #sed -i 's|\(^\s*'"$vname"'\s*\=\s*\)\(.*$\)|\1'"$value"'|g' $filename cp ${filename} ${filename}.check sed -i.sedbak -e 's|\(^[[:space:]]*'"$vname"'[[:space:]]*=[[:space:]]*\)\(.*$\)|\1'"$foundstring"'|g' ${filename}.check grep -q ${foundstring} ${filename}.check if [ $? -eq 0 ]; then sed -i.sedbak -e 's|\(^[[:space:]]*'"$vname"'[[:space:]]*=[[:space:]]*\)\(.*$\)|\1'"$value"'|g' ${filename} + if [[ "${found}" == "${foundstring}" ]]; then + vnamearray+=($vname) + valuearray+=($value) + else + valuearray[$found]=${value} + fi if [[ -e "${filename}.sedbak" ]]; then rm ${filename}.sedbak fi else - echo "$0 ERROR: parsing error for ${vname}" + echo "${scriptname} ERROR: parsing error for ${vname}" exit -99 fi rm ${filename}.check ${filename}.check.sedbak diff --git a/configuration/scripts/parse_settings.sh b/configuration/scripts/parse_settings.sh index f797dbebe..d6ed31c15 100755 --- a/configuration/scripts/parse_settings.sh +++ b/configuration/scripts/parse_settings.sh @@ -5,11 +5,15 @@ if [[ "$#" -ne 2 ]]; then exit -1 fi +scriptname=`basename "$0"` filename=$1 filemods=$2 #echo "$0 $1 $2" echo "running parse_settings.sh" +foundstring="FoundSTRING" +vnamearray=() +valuearray=() while read -r line do @@ -23,8 +27,32 @@ do value=`echo $line | sed "s|\(^[[:space:]]*set[^[:space:]]*\)[[:space:]][[:space:]]*\([^[:space:]]*\)[[:space:]][[:space:]]*\([^[:space:]]*\).*$|\3|g"` # echo "$line $vname $value" + found=${foundstring} + for i in "${!vnamearray[@]}"; do + if [[ "${found}" == "${foundstring}" ]]; then + vn=${vnamearray[$i]} + vv=${valuearray[$i]} +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + if [[ "$vname" == "$vn" ]]; then + found=$i + if [[ "$value" != "${vv}" ]]; then +# echo "names/values $i ${vname} ${vn} ${value} ${vv}" + echo "${scriptname} WARNING: re-overriding $vname from ${vv} to ${value}" + fi + fi + fi + done + #sed -i 's|\(^\s*set.* '"$vname"' \)[^#]*\(#*.*$\)|\1 '"$value"' \2|g' $filename sed -i.sedbak -e 's|\(^[[:space:]]*set.* '"$vname"' \)[^#]*\(#*.*$\)|\1 '"$value"' \2|g' $filename + + if [[ "${found}" == "${foundstring}" ]]; then + vnamearray+=($vname) + valuearray+=($value) + else + valuearray[$found]=${value} + fi + if [[ -e "${filename}.sedbak" ]]; then rm ${filename}.sedbak fi diff --git a/configuration/scripts/tests/cice.lcov.csh b/configuration/scripts/tests/cice.lcov.csh index 8107778d9..5772833d1 100644 --- a/configuration/scripts/tests/cice.lcov.csh +++ b/configuration/scripts/tests/cice.lcov.csh @@ -9,7 +9,7 @@ set lcovhtmldir = lcov_cice_${report_name} genhtml -o ./${lcovhtmldir} --precision 2 -t "${report_name}" total.info rm -r -f ${lcovrepo} -git clone https://github.com/apcraig/${lcovrepo} +git clone --depth=1 https://github.com/apcraig/${lcovrepo} cp -p -r ${lcovhtmldir} ${lcovrepo}/ cd ${lcovrepo} diff --git a/configuration/scripts/tests/cice_test_codecov.csh b/configuration/scripts/tests/cice_test_codecov.csh index be9399f1b..d9a69e898 100755 --- a/configuration/scripts/tests/cice_test_codecov.csh +++ b/configuration/scripts/tests/cice_test_codecov.csh @@ -29,7 +29,7 @@ cd ${testdir} # Check out current cice master echo " " echo "*** checkout current cice master ***" -git clone https://github.com/cice-consortium/cice cice.master.${date} --recursive +git clone --depth=1 https://github.com/cice-consortium/cice cice.master.${date} --recursive cd cice.master.${date} set hash = `git rev-parse --short HEAD ` cd ../ @@ -40,7 +40,7 @@ cd ../ # This also copies in all dot file at the root that do not start with .g (ie. .git*) echo " " echo "*** checkout current test_cice_master ***" -git clone https://github.com/apcraig/test_cice_icepack test_cice_icepack.${date} +git clone --depth=1 https://github.com/apcraig/test_cice_icepack test_cice_icepack.${date} cd test_cice_icepack.${date} echo " " echo "*** remove current files and copy in cice master files ***" diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts index c1edec292..3e98642e9 100755 --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -1,8 +1,9 @@ # Test Grid PEs Sets BFB-compare +# some iobinary configurations fail due to bathymetry netcdf file requirement, remove them restart gx3 8x4 debug,histall,iobinary,precision8 -restart gx3 12x2 alt01,histall,iobinary +#restart gx3 12x2 alt01,histall,iobinary restart gx3 16x2 alt02,histall,iobinary,precision8 -restart gx3 4x2 alt03,histall,iobinary +#restart gx3 4x2 alt03,histall,iobinary restart gx3 8x4 alt04,histall,iobinary,precision8 restart gx3 4x4 alt05,histall,iobinary restart gx3 32x1 bgcz,histall,iobinary,precision8 diff --git a/configuration/scripts/tests/report_results.csh b/configuration/scripts/tests/report_results.csh index e3f8eed70..2eb3731d5 100755 --- a/configuration/scripts/tests/report_results.csh +++ b/configuration/scripts/tests/report_results.csh @@ -25,7 +25,7 @@ set wikirepo = "https://github.com/CICE-Consortium/Test-Results.wiki.git" set wikiname = Test-Results.wiki rm -r -f ${wikiname} -git clone ${wikirepo} ${wikiname} +git clone --depth=1 ${wikirepo} ${wikiname} if ($status != 0) then echo " " echo "${0}: ERROR git clone failed" diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 1d3baca38..229fa92d5 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -29,6 +29,7 @@ either Celsius or Kelvin units). "a4Df", "history field accumulations, 4D categories, fsd", "" "a_min", "minimum area concentration for computing velocity", "0.001" "a_rapid_mode", ":math:`{\bullet}` brine channel diameter", "" + "add_mpi_barriers", ":math:`\bullet` turns on MPI barriers for communication throttling", "" "advection", ":math:`\bullet` type of advection algorithm used (‘remap’ or ‘upwind’)", "remap" "afsd(n)", "floe size distribution (in category n)", "" "ahmax", ":math:`\bullet` thickness above which ice albedo is constant", "0.3m" @@ -252,6 +253,10 @@ either Celsius or Kelvin units). "fswint", "shortwave absorbed in ice interior", "W/m\ :math:`^2`" "fswpenl", "shortwave penetrating through ice layers", "W/m\ :math:`^2`" "fswthru", "shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdr", "visible direct shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_vdf", "visible diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idr", "near IR direct shortwave penetrating to ocean", "W/m\ :math:`^2`" + "fswthru_idf", "near IR diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" "fyear", "current data year", "" "fyear_final", "last data year", "" diff --git a/doc/source/intro/citing.rst b/doc/source/intro/citing.rst index 8f4e142c8..c128bc4e6 100644 --- a/doc/source/intro/citing.rst +++ b/doc/source/intro/citing.rst @@ -5,14 +5,26 @@ Citing the CICE code ==================== -If you use the CICE code, please cite the version you are using with the CICE -Digital Object Identifier (DOI): +Each individual release has its own Digital Object Identifier (DOI), +e.g. CICE v6.1.2 has DOI 10.5281/zenodo.3888653. All versions of +this lineage (e.g. CICE6) can be cited by using the DOI +10.5281/zenodo.1205674 (https://zenodo.org/record/1205674). This DOI +represents all v6 releases, and will always resolve to the latest one. +More information can be found by following the DOI link to zenodo. -DOI:10.5281/zenodo.1205674 (https://zenodo.org/record/1205674) +If you use CICE, please cite the version number of the code you +are using or modifying. -This DOI can be used to cite all CICE versions and the URL will default to the most recent version. -However, each released version of CICE will also receive its own, unique DOI that can be -used for citations as well. +If using code from the CICE-Consortium repository ``master`` branch +that includes modifications +that have not yet been released with a version number, then in +addition to the most recent version number, the hash at time of +download can be cited, determined by executing the command ``git log`` +in your clone. -Please also make the CICE Consortium aware of any publications and model use. +A hash can also be cited for your own modifications, once they have +been committed to a repository branch. + +Please also make the CICE Consortium aware of any publications and +model use. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 5512841a2..550162515 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -8,7 +8,51 @@ Case Settings There are two important files that define the case, **cice.settings** and **ice_in**. **cice.settings** is a list of env variables that define many values used to setup, build and run the case. **ice_in** is the input namelist file -for CICE. Variables in both files are described below. +for CICE. Variables in both files are described below. In addition, the first +table lists available preprocessor macros to activate or deactivate various +features when compiling. + +.. _tabcpps: + +Table of C Preprocessor (CPP) Macros +--------------------------------------------------- + +The CICE model supports a number of C Preprocessor (CPP) Macros. These +can be turned on during compilation to activate different pieces of source +code. The main purpose is to introduce build-time code modifications to +include or exclude certain libraries or Fortran language features. More information +can be found in :ref:`cicecpps`. The following CPPs are available. + +.. csv-table:: **CPP Macros** + :header: "CPP name", "description" + :widths: 15, 60 + + "","" + "**General Macros**", "" + "CESM1_PIO", "Provide backwards compatible support for PIO interfaces/version released with CESM1 in about 2010" + "ESMF_INTERFACE", "Turns on ESMF support in a subset of driver code. Also USE_ESMF_LIB and USE_ESMF_METADATA" + "FORTRANUNDERSCORE", "Used in ice_shr_reprosum86.c to support Fortran-C interfaces. This should generally be turned on at all times. There are other CPPs (FORTRANDOUBULEUNDERSCORE, FORTRANCAPS, etc) in ice_shr_reprosum.c that are generally not used in CICE but could be useful if problems arise in the Fortran-C interfaces" + "GPTL", "Turns on GPTL initialization if needed for PIO" + "key_oasis3", "Leverages Oasis CPPs to define the local MPI communicator" + "key_oasis3mct", "Leverages Oasis CPPs to define the local MPI communicator" + "key_oasis4", "Leverages Oasis CPPs to define the local MPI communicator" + "key_iomput", "Leverages Oasis CPPs to define the local MPI communicator" + "NO_F2003", "Turns off some Fortran 2003 features" + "NO_I8", "Converts integer*8 to integer*4. This could have adverse affects for certain algorithms including the ddpdd implementation associated with the ``bfbflag``" + "NO_R16", "Converts real*16 to real*8. This could have adverse affects for certain algorithms including the lsum16 implementation associated with the ``bfbflag``" + "USE_NETCDF", "Turns on netcdf code. This is normally on and is needed for released configurations. An older value, ncdf, is still supported" + "","" + "**Application Macros**", "" + "CESMCOUPLED", "Turns on code changes for the CESM coupled application " + "CICE_IN_NEMO", "Turns on code changes for coupling in the NEMO ocean model" + "CICE_DMI", "Turns on code changes for the DMI coupled model application" + "ICE_DA", "Turns on code changes in the hadgem driver" + "RASM_MODS", "Turns on code changes for the RASM coupled application" + "","" + "**Library Macros**", "" + "_OPENMP", "Automatically defined when compiling with OpenMP " + "_OPENACC", "Automatically defined when compiling with OpenACC " + .. _tabsettings: @@ -37,7 +81,7 @@ can be modified as needed. "ICE_RSTDIR", "string", "unused", "${ICE_RUNDIR}/restart" "ICE_HSTDIR", "string", "unused", "${ICE_RUNDIR}/history" "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" - "ICE_DRVOPT", "string", "unused", "cice" + "ICE_DRVOPT", "string", "unused", "standalone/cice" "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" " ", "netcdf", "serial netCDF" " ", "pio", "parallel netCDF" @@ -126,7 +170,7 @@ setup_nml "``histfreq_n``", "integer array", "frequency history output is written with ``histfreq``", "1,1,1,1,1" "``history_dir``", "string", "path to history output directory", "'./'" "``history_file``", "string", "output file for history", "'iceh'" - "``history_format``", "``default``", "read/write restart files in default format", "``default``" + "``history_format``", "``default``", "read/write history files in default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" "``history_precision``", "integer", "history file precision: 4 or 8 byte", "4" "``ice_ic``", "``default``", "latitude and sst dependent initial condition", "``default``" @@ -148,7 +192,6 @@ setup_nml "``restart``", "logical", "initialize using restart file", "``.false.``" "``restart_dir``", "string", "path to restart directory", "'./'" "``restart_ext``", "logical", "read/write halo cells in restart files", "``.false.``" - "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restart_file``", "string", "output file prefix for restart dump", "'iced'" "``restart_format``", "``default``", "read/write restart file with default format", "``default``" "", "``pio_pnetcdf``", "read/write restart files with pnetcdf in pio", "" @@ -171,6 +214,8 @@ grid_nml "", "", "", "" "``bathymetry_file``", "string", "name of bathymetry file to be read", "‘unknown_bathymetry_file’" + "``bathymetry_format``", "``default``", "NetCDF depth field", "‘default’" + "", "``pop``", "pop thickness file in cm in ascii format", "" "``close_boundaries``", "logical", "set land on edges of grid", "``.false.``" "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dyrect``", "real", "y-direction grid spacing for rectangular grid in cm", "0.0" @@ -193,6 +238,7 @@ grid_nml "``nfsd``", "integer", "number of floe size categories", "1" "``nilyr``", "integer", "number of vertical layers in ice", "0" "``nslyr``", "integer", "number of vertical layers in snow", "0" + "``orca_halogrid``", "logical", "use orca haloed grid for data/grid read", "``.false.``" "``use_bathymetry``", "logical", "use read in bathymetry file for basalstress option", "``.false.``" "", "", "", "" @@ -204,6 +250,7 @@ domain_nml :widths: 15, 15, 30, 15 "", "", "", "" + "``add_mpi_barriers``", "logical", "throttle communication", "``.false.``" "``block_size_x``", "integer", "block size in x direction", "-1" "``block_size_y``", "integer", "block size in y direction", "-1" "``distribution_type``", "``cartesian``", "2D cartesian block distribution method", "``cartesian``" @@ -297,6 +344,9 @@ thermo_nml "``phi_c_slow_mode``", ":math:`0<\phi_c < 1`", "critical liquid fraction", "0.05" "``phi_i_mushy``", ":math:`0<\phi_i < 1`", "solid fraction at lower boundary", "0.85" "``Rac_rapid_mode``", "real", "critical Rayleigh number", "10.0" + "``sw_redist``", "logical", "redistribute internal shortwave to surface", "``.false.``" + "``sw_frac``", "real", "fraction redistributed", "0.9" + "``sw_dtemp``", "real", "temperature difference from melt to start redistributing", "0.02" "", "", "", "" dynamics_nml @@ -315,9 +365,9 @@ dynamics_nml "``basalstress``", "logical", "use basal stress parameterization for landfast ice", "``.false.``" "``Cf``", "real", "ratio of ridging work to PE change in ridging", "17.0" "``coriolis``", "``constant``", "constant coriolis value = 1.46e-4", "``latitude``" - "``Cstar``", "real", "constant in Hibler strength formula", "20" "", "``latitude``", "coriolis variable by latitude", "" "", "``zero``", "zero coriolis", "" + "``Cstar``", "real", "constant in Hibler strength formula", "20" "``e_ratio``", "real", "EVP ellipse aspect ratio", "2.0" "``kdyn``", "``-1``", "dynamics algorithm OFF", "1" "", "``0``", "dynamics OFF", "" @@ -342,6 +392,8 @@ dynamics_nml "``ndte``", "integer", "number of EVP subcycles", "120" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" "``revised_evp``", "logical", "use revised EVP formulation", "``.false.``" + "``ssh_stress``", "``coupled``", "computed from coupled sea surface height gradient", "``geostrophic``" + "", "``geostropic``", "computed from ocean velocity", "" "``threshold_hw``", "real", "Max water depth for grounding (see :cite:`Amundrud04`)", "30." "``yield_curve``", "``ellipse``", "elliptical yield curve", "``ellipse``" "", "", "", "" @@ -452,6 +504,7 @@ forcing_nml "", "``mm_per_month``", "", "" "", "``mm_per_sec``", "(same as MKS units)", "" "", "``m_per_sec``", "", "" + "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restore_ocn``", "logical", "restore sst to data", "``.false.``" "``restore_ice``", "logical", "restore ice state along lateral boundaries", "``.false.``" "``tfrz_option``", "``linear_salt``", "linear functino of salinity (ktherm=1)", "``mushy``" @@ -651,5 +704,3 @@ icefields_nml "", "``md``", "*e.g.,* write both monthly and daily files", "" "", "", "", "" - - diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 44d4ef1d6..cbfe37b0c 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -181,6 +181,12 @@ that prints out the variable ``blkmask`` to the history file and which labels the blocks in the grid decomposition according to ``blkmask = my_task + iblk/100``. +The namelist ``add_mpi_barriers`` can be set to ``.true.`` to help +throttle communication for communication intensive configurations. This +may slow the code down a bit. These barriers have been added to +a few select locations, but it's possible others may be needed. As a general +rule, ``add_mpi_barriers`` should be ``.false.``. + ************* Tripole grids ************* diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 8befee9cb..957cfc4fc 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -14,9 +14,10 @@ Software Requirements To run stand-alone, CICE requires +- bash and csh - gmake (GNU Make) - Fortran and C compilers (Intel, PGI, GNU, Cray, and NAG have been tested) -- NetCDF +- NetCDF (this is actually optional but required to test out of the box configurations) - MPI (this is actually optional but without it you can only run on 1 processor) Below are lists of software versions that the Consortium has tested at some point. There is no @@ -202,7 +203,10 @@ specifies the compilation environment associated with the machine. This should specifies the grid. This is a string and for the current CICE driver, gx1, gx3, and tx1 are supported. (default = gx3) ``--set``, ``-s`` SET1,SET2,SET3 - specifies the optional settings for the case. The settings for ``--suite`` are defined in the suite file. Multiple settings can be specified by providing a comma deliminated set of values without spaces between settings. The available settings are in **configurations/scripts/options** and ``cice.setup --help`` will also list them. These settings files can change either the namelist values or overall case settings (such as the debug flag). + specifies the optional settings for the case. The settings for ``--suite`` are defined in the suite file. Multiple settings can be specified by providing a comma deliminated set of values without spaces between settings. The available settings are in **configurations/scripts/options** and ``cice.setup --help`` will also list them. These settings files can change either the namelist values or overall case settings (such as the debug flag). For cases and tests (not suites), settings defined in **~/.cice_set** (if it exists) will be included in the --set options. This behaviour can be overridden with the `--ignore-user-set`` command line option. + +``--ignore-user-set`` + ignores settings defined in **~/.cice.set** (if it exists) for cases and tests. **~/.cice_set** is always ignored for test suites. For CICE, when setting up cases, the ``--case`` and ``--mach`` must be specified. It's also recommended that ``--env`` be set explicitly as well. @@ -228,7 +232,13 @@ settings (options), the set_env.setting and set_nml.setting will be used to change the defaults. This is done as part of the ``cice.setup`` and the modifications are resolved in the **cice.settings** and **ice_in** file placed in the case directory. If multiple options are chosen that conflict, then the last -option chosen takes precedent. Not all options are compatible with each other. +option chosen takes precedence. Not all options are compatible with each other. + +Settings defined in **~/.cice_set** (if it exists) will be included in the ``--set`` +options. This behaviour can be overridden with the `--ignore-user-set`` command +line option. The format of the **~/.cice_set** file is a identical to the +``--set`` option, a single comma-delimited line of options. Settings on the +command line will take precedence over settings defined in **~/.cice_set**. Some of the options are @@ -350,6 +360,25 @@ automatically clean the prior build. If incremental builds are desired to save time during development, the ``ICE_CLEANBUILD`` setting in **cice.settings** should be modified. +.. _cicecpps: + +C Preprocessor (CPP) Macros +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +There are a number of C Preprocessing Macros supported in the CICE model. These +allow certain coding features like NetCDF, MPI, or specific Fortran features to be +excluded or included during the compile. + +The CPPs are defined by the `CPPDEFS` variable in the Makefile. They are defined +by passing the -D[CPP] to the C and Fortran compilers (ie. -DUSE_NETCDF) and this +is what needs to be set in the `CPPDEFS` variable. The value of `ICE_CPPDEFS` in +**cice.settings** is copied into the Makefile `CPPDEFS` variable as are settings +hardwired into the **Macros.[machine]_[environment]** file. + +In general, ``-DFORTRANUNDERSCORE`` should always be set to support the Fortran/C +interfaces in **ice_shr_reprosum.c**. In addition, if NetCDF is used, ``-DUSE_NETCDF`` +should also be defined. A list of available CPPs can be found in +:ref:`tabcpps`. .. _porting: @@ -453,7 +482,7 @@ the **env.[machine]** file. The easiest way to change a user's default is to create a file in your home directory called **.cice\_proj** and add your preferred account name to the first line. There is also an option (``--acct``) in **cice.setup** to define the account number. -The order of precedent is **cice.setup** command line option, +The order of precedence is **cice.setup** command line option, **.cice\_proj** setting, and then value in the **env.[machine]** file. .. _queue: diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 8f8fe9441..5369efe5f 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -56,6 +56,8 @@ For individual tests, the following command line options can be set ``--set`` SET1,SET2,SET3 (see :ref:`case_options`) +``--ignore-user-set`` (see :ref:`case_options`) + ``--acct`` ACCOUNT (see :ref:`case_options`) ``--grid`` GRID (see :ref:`case_options`) @@ -312,7 +314,7 @@ If a user adds ``--set`` to the suite, all tests in that suite will add that opt ./cice.setup --suite base_suite,decomp_suite --mach wolf --env gnu --testid myid -s debug -The option settings defined in the suite have precendent over the command line +The option settings defined in the suite have precendence over the command line values if there are conflicts. The predefined test suites are defined under **configuration/scripts/tests** and @@ -459,7 +461,7 @@ Test Suite Examples ./results.csh If there are conflicts between the ``--set`` options in the suite and on the command line, - the suite will take precedent. + the suite will take precedence. 5) **Multiple test suites from a single command line** diff --git a/icepack b/icepack index b1e41d9f1..4c42a82e3 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit b1e41d9f12a59390aacdb933889c3c4a87c9e8d2 +Subproject commit 4c42a82e3d92f191a9c52bca3831e8d242e2e4c0 From d81a834d815f5df625d819fc72d333a6f114ce69 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 13 Aug 2020 09:40:18 -0400 Subject: [PATCH 26/44] Fixcommit (#14) Align commit history between emc/develop and cice-consortium/master From 285985c089319010dab260b6c335a96911dbad9a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 31 Aug 2020 12:53:02 -0400 Subject: [PATCH 27/44] Update CICE6 for integration to S2S * add wcoss_dell_p3 compiler macro * update to icepack w/ debug fix * replace SITE with MACHINE_ID * update compile scripts --- .gitmodules | 2 +- .../dynamics/ice_transport_driver.F90 | 142 +++++++++--------- cicecore/cicedynB/general/ice_init.F90 | 12 +- cicecore/cicedynB/general/ice_step_mod.F90 | 14 +- cicecore/shared/ice_init_column.F90 | 22 ++- cicecore/version.txt | 2 +- .../forapps/ufs/comp_ice.backend.clean | 10 +- .../forapps/ufs/comp_ice.backend.libcice | 10 +- .../scripts/machines/Macros.hera_intel | 12 +- .../scripts/machines/Macros.orion_intel | 12 +- .../machines/Macros.wcoss_dell_p3_intel | 49 ++++++ configuration/scripts/options/set_nml.alt04 | 2 +- configuration/scripts/tests/QC/cice.t-test.py | 7 +- doc/source/cice_index.rst | 2 +- doc/source/conf.py | 4 +- doc/source/developer_guide/dg_dynamics.rst | 5 +- doc/source/science_guide/sg_horiztrans.rst | 2 +- doc/source/user_guide/ug_case_settings.rst | 4 +- doc/source/user_guide/ug_testing.rst | 2 +- icepack | 2 +- 20 files changed, 194 insertions(+), 123 deletions(-) create mode 100644 configuration/scripts/machines/Macros.wcoss_dell_p3_intel diff --git a/.gitmodules b/.gitmodules index 22e452f35..8a773d230 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "icepack"] path = icepack - url = https://github.com/cice-consortium/Icepack + url = https://github.com/NOAA-EMC/Icepack diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index c500e1631..82e04dc71 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -1,6 +1,7 @@ !======================================================================= ! -! Drivers for remapping and upwind ice transport +!deprecate upwind Drivers for remapping and upwind ice transport +! Drivers for incremental remapping ice transport ! ! authors: Elizabeth C. Hunke and William H. Lipscomb, LANL ! @@ -9,6 +10,7 @@ ! 2006: Incorporated remap transport driver and renamed from ! ice_transport_upwind. ! 2011: ECH moved edgearea arrays into ice_transport_remap.F90 +! 2020: deprecated upwind transport module ice_transport_driver @@ -28,12 +30,13 @@ module ice_transport_driver implicit none private - public :: init_transport, transport_remap, transport_upwind + public :: init_transport, transport_remap!deprecate upwind:, transport_upwind character (len=char_len), public :: & advection ! type of advection scheme used - ! 'upwind' => 1st order donor cell scheme +!deprecate upwind ! 'upwind' => 1st order donor cell scheme ! 'remap' => remapping scheme + ! 'none' => advection off (ktransport = -1 also turns it off) logical, parameter :: & ! if true, prescribe area flux across each edge l_fixed_area = .false. @@ -69,8 +72,9 @@ module ice_transport_driver !======================================================================= ! ! This subroutine is a wrapper for init_remap, which initializes the -! remapping transport scheme. If the model is run with upwind -! transport, no initializations are necessary. +! remapping transport scheme. +!deprecate upwind If the model is run with upwind +!deprecate upwind! transport, no initializations are necessary. ! ! authors William H. Lipscomb, LANL @@ -680,11 +684,12 @@ subroutine transport_remap (dt) end subroutine transport_remap !======================================================================= -! +!deprecate upwind! ! Computes the transport equations for one timestep using upwind. Sets ! several fields into a work array and passes it to upwind routine. - subroutine transport_upwind (dt) +!deprecate upwind + subroutine transport_upwind_deprecated (dt) use ice_boundary, only: ice_HaloUpdate use ice_blocks, only: nx_block, ny_block, block, get_block, nx_block, ny_block @@ -769,52 +774,52 @@ subroutine transport_upwind (dt) field_loc_Nface, field_type_vector) call ice_timer_stop(timer_bound) - !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) - do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - +!deprecate upwind !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) +!deprecate upwind do iblk = 1, nblocks +!deprecate upwind this_block = get_block(blocks_ice(iblk),iblk) +!deprecate upwind ilo = this_block%ilo +!deprecate upwind ihi = this_block%ihi +!deprecate upwind jlo = this_block%jlo +!deprecate upwind jhi = this_block%jhi !----------------------------------------------------------------- ! fill work arrays with fields to be advected !----------------------------------------------------------------- - call state_to_work (nx_block, ny_block, & - ntrcr, & - narr, trcr_depend, & - aicen (:,:, :,iblk), trcrn (:,:,:,:,iblk), & - vicen (:,:, :,iblk), vsnon (:,:, :,iblk), & - aice0 (:,:, iblk), works (:,:, :,iblk)) +!deprecate upwind +!deprecate upwind call state_to_work (nx_block, ny_block, & +!deprecate upwind ntrcr, & +!deprecate upwind narr, trcr_depend, & +!deprecate upwind aicen (:,:, :,iblk), trcrn (:,:,:,:,iblk), & +!deprecate upwind vicen (:,:, :,iblk), vsnon (:,:, :,iblk), & +!deprecate upwind aice0 (:,:, iblk), works (:,:, :,iblk)) !----------------------------------------------------------------- ! advect !----------------------------------------------------------------- - call upwind_field (nx_block, ny_block, & - ilo, ihi, jlo, jhi, & - dt, & - narr, works(:,:,:,iblk), & - uee(:,:,iblk), vnn (:,:,iblk), & - HTE(:,:,iblk), HTN (:,:,iblk), & - tarea(:,:,iblk)) +!deprecate upwind call upwind_field (nx_block, ny_block, & +!deprecate upwind ilo, ihi, jlo, jhi, & +!deprecate upwind dt, & +!deprecate upwind narr, works(:,:,:,iblk), & +!deprecate upwind uee(:,:,iblk), vnn (:,:,iblk), & +!deprecate upwind HTE(:,:,iblk), HTN (:,:,iblk), & +!deprecate upwind tarea(:,:,iblk)) !----------------------------------------------------------------- ! convert work arrays back to state variables !----------------------------------------------------------------- - call work_to_state (nx_block, ny_block, & - ntrcr, narr, & - trcr_depend(:), trcr_base(:,:), & - n_trcr_strata(:), nt_strata(:,:), & - aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & - vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & - aice0(:,:, iblk), works (:,:, :,iblk)) +!deprecate upwind call work_to_state (nx_block, ny_block, & +!deprecate upwind ntrcr, narr, & +!deprecate upwind trcr_depend(:), trcr_base(:,:), & +!deprecate upwind n_trcr_strata(:), nt_strata(:,:), & +!deprecate upwind aicen(:,:, :,iblk), trcrn (:,:,:,:,iblk), & +!deprecate upwind vicen(:,:, :,iblk), vsnon (:,:, :,iblk), & +!deprecate upwind aice0(:,:, iblk), works (:,:, :,iblk)) - enddo ! iblk - !$OMP END PARALLEL DO +!deprecate upwind enddo ! iblk +!deprecate upwind !$OMP END PARALLEL DO deallocate (works) @@ -832,7 +837,8 @@ subroutine transport_upwind (dt) call ice_timer_stop(timer_advect) ! advection - end subroutine transport_upwind + end subroutine transport_upwind_deprecated +!deprecate upwind !======================================================================= ! The next few subroutines (through check_monotonicity) are called @@ -1455,12 +1461,12 @@ subroutine check_monotonicity (nx_block, ny_block, & end subroutine check_monotonicity !======================================================================= -! The remaining subroutines are called by transport_upwind. +!deprecate upwind! The remaining subroutines are called by transport_upwind. !======================================================================= ! ! Fill work array with state variables in preparation for upwind transport - - subroutine state_to_work (nx_block, ny_block, & +!deprecate upwind + subroutine state_to_work_deprecated (nx_block, ny_block, & ntrcr, & narr, trcr_depend, & aicen, trcrn, & @@ -1601,13 +1607,13 @@ subroutine state_to_work (nx_block, ny_block, & if (narr /= narrays) write(nu_diag,*) & "Wrong number of arrays in transport bound call" - end subroutine state_to_work + end subroutine state_to_work_deprecated !======================================================================= ! ! Convert work array back to state variables - - subroutine work_to_state (nx_block, ny_block, & +!deprecate upwind + subroutine work_to_state_deprecated (nx_block, ny_block, & ntrcr, narr, & trcr_depend, & trcr_base, & @@ -1715,13 +1721,13 @@ subroutine work_to_state (nx_block, ny_block, & if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - end subroutine work_to_state + end subroutine work_to_state_deprecated !======================================================================= ! ! upwind transport algorithm - - subroutine upwind_field (nx_block, ny_block, & +!deprecate upwind + subroutine upwind_field_deprecated (nx_block, ny_block, & ilo, ihi, jlo, jhi, & dt, & narrays, phi, & @@ -1764,26 +1770,26 @@ subroutine upwind_field (nx_block, ny_block, & do n = 1, narrays - do j = 1, jhi - do i = 1, ihi - worka(i,j)= & - upwind(phi(i,j,n),phi(i+1,j,n),uee(i,j),HTE(i,j),dt) - workb(i,j)= & - upwind(phi(i,j,n),phi(i,j+1,n),vnn(i,j),HTN(i,j),dt) - enddo - enddo - - do j = jlo, jhi - do i = ilo, ihi - phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j) & - + workb(i,j)-workb(i,j-1) ) & - / tarea(i,j) - enddo - enddo +!deprecate upwind do j = 1, jhi +!deprecate upwind do i = 1, ihi +!deprecate upwind worka(i,j)= & +!deprecate upwind upwind(phi(i,j,n),phi(i+1,j,n),uee(i,j),HTE(i,j),dt) +!deprecate upwind workb(i,j)= & +!deprecate upwind upwind(phi(i,j,n),phi(i,j+1,n),vnn(i,j),HTN(i,j),dt) +!deprecate upwind enddo +!deprecate upwind enddo + +!deprecate upwind do j = jlo, jhi +!deprecate upwind do i = ilo, ihi +!deprecate upwind phi(i,j,n) = phi(i,j,n) - ( worka(i,j)-worka(i-1,j) & +!deprecate upwind + workb(i,j)-workb(i,j-1) ) & +!deprecate upwind / tarea(i,j) +!deprecate upwind enddo +!deprecate upwind enddo enddo ! narrays - end subroutine upwind_field + end subroutine upwind_field_deprecated !======================================================================= @@ -1791,13 +1797,13 @@ end subroutine upwind_field ! Define upwind function !------------------------------------------------------------------- - real(kind=dbl_kind) function upwind(y1,y2,a,h,dt) +!deprecate upwind real(kind=dbl_kind) function upwind(y1,y2,a,h,dt) - real(kind=dbl_kind), intent(in) :: y1,y2,a,h,dt +!deprecate upwind real(kind=dbl_kind), intent(in) :: y1,y2,a,h,dt - upwind = p5*dt*h*((a+abs(a))*y1+(a-abs(a))*y2) +!deprecate upwind upwind = p5*dt*h*((a+abs(a))*y1+(a-abs(a))*y2) - end function upwind +!deprecate upwind end function upwind !======================================================================= diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index d3b096eb3..f2eaae17d 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -795,7 +795,11 @@ subroutine input_data abort_list = trim(abort_list)//":1" endif - if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then +!deprecate upwind if (advection /= 'remap' .and. advection /= 'upwind' .and. advection /= 'none') then + if (advection /= 'remap' .and. advection /= 'none') then + if (trim(advection) == 'upwind') then + if (my_task == master_task) write(nu_diag,*) subname//' ERROR: upwind advection has been deprecated' + endif if (my_task == master_task) write(nu_diag,*) subname//' ERROR: invalid advection=',trim(advection) abort_list = trim(abort_list)//":3" endif @@ -1178,8 +1182,10 @@ subroutine input_data tmpstr2 = ' transport enabled' if (trim(advection) == 'remap') then tmpstr2 = ': linear remapping advection' - elseif (trim(advection) == 'upwind') then - tmpstr2 = ': donor cell (upwind) advection' +!deprecate upwind elseif (trim(advection) == 'upwind') then +!deprecate upwind tmpstr2 = ': donor cell (upwind) advection' + elseif (trim(advection) == 'none') then + tmpstr2 = ': advection off' endif write(nu_diag,*) 'advection = ', trim(advection),trim(tmpstr2) else diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 7a2493d58..77d0ad492 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -852,7 +852,8 @@ subroutine step_dyn_horiz (dt) use ice_dyn_eap, only: eap use ice_dyn_shared, only: kdyn, ktransport use ice_flux, only: init_history_dyn - use ice_transport_driver, only: advection, transport_upwind, transport_remap +!deprecate upwind use ice_transport_driver, only: advection, transport_upwind, transport_remap + use ice_transport_driver, only: advection, transport_remap real (kind=dbl_kind), intent(in) :: & dt ! dynamics time step @@ -872,12 +873,13 @@ subroutine step_dyn_horiz (dt) ! Horizontal ice transport !----------------------------------------------------------------- - if (ktransport > 0) then - if (advection == 'upwind') then - call transport_upwind (dt) ! upwind - else +!deprecate upwind if (ktransport > 0) then + if (ktransport > 0 .and. advection == 'remap') then +!deprecate upwind if (advection == 'upwind') then +!deprecate upwind call transport_upwind (dt) ! upwind +!deprecate upwind else call transport_remap (dt) ! incremental remapping - endif +!deprecate upwind endif endif end subroutine step_dyn_horiz diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index 0370a0d7e..b3937c0cd 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -877,7 +877,7 @@ subroutine init_bgc() endif ! .not. restart - !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -889,15 +889,6 @@ subroutine init_bgc() do j = jlo, jhi do i = ilo, ihi - do n = 1, ncat - do k = 1, nilyr - sicen(k,n) = trcrn(i,j,nt_sice+k-1,n,iblk) - enddo - do k = ntrcr_o+1, ntrcr - trcrn_bgc(k-ntrcr_o,n) = trcrn(i,j,k,n,iblk) - enddo - enddo - call icepack_load_ocean_bio_array(max_nbtrcr=icepack_max_nbtrcr, & max_algae=icepack_max_algae, max_don=icepack_max_don, & max_doc=icepack_max_doc, max_fe=icepack_max_fe, & @@ -919,7 +910,7 @@ subroutine init_bgc() file=__FILE__, line=__LINE__) if (.not. restart_bgc) then - !$OMP PARALLEL DO PRIVATE(iblk,i,j,n,ilo,ihi,jlo,jhi,this_block) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,k,n,ilo,ihi,jlo,jhi,this_block,sicen,trcrn_bgc) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) @@ -930,7 +921,14 @@ subroutine init_bgc() do j = jlo, jhi do i = ilo, ihi - + do n = 1, ncat + do k = 1, nilyr + sicen(k,n) = trcrn(i,j,nt_sice+k-1,n,iblk) + enddo + do k = ntrcr_o+1, ntrcr + trcrn_bgc(k-ntrcr_o,n) = trcrn(i,j,k,n,iblk) + enddo + enddo call icepack_init_bgc(ncat=ncat, nblyr=nblyr, nilyr=nilyr, ntrcr_o=ntrcr_o, & cgrid=cgrid, igrid=igrid, ntrcr=ntrcr, nbtrcr=nbtrcr, & sicen=sicen(:,:), trcrn=trcrn_bgc(:,:), sss=sss(i,j, iblk), & diff --git a/cicecore/version.txt b/cicecore/version.txt index 43f856223..83a606cb9 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.1.2 +CICE 6.1.3 diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean index 823f1f586..af6cfe9ab 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.clean +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.clean @@ -1,19 +1,21 @@ #! /bin/csh -f ### Expect to find the following environment variables set on entry: -# SITE +# MACHINE_ID # SYSTEM_USERDIR # SRCDIR # EXEDIR setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR -if (${SITE} =~ cheyenne*) then +if (${MACHINE_ID} =~ cheyenne*) then setenv ARCH cheyenne_intel -else if (${SITE} =~ orion*) then +else if (${MACHINE_ID} =~ orion*) then setenv ARCH orion_intel -else if (${SITE} =~ hera*) then +else if (${MACHINE_ID} =~ hera*) then setenv ARCH hera_intel +else if (${MACHINE_ID} =~ wcoss*) then + setenv ARCH wcoss_dell_p3_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index ea38e048b..1b5b142a5 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -1,7 +1,7 @@ #! /bin/csh -f ### Expect to find the following environment variables set on entry: -# SITE +# MACHINE_ID # SYSTEM_USERDIR # SRCDIR # EXEDIR @@ -16,12 +16,14 @@ setenv OBJDIR $EXEDIR/compile ; if !(-d $OBJDIR) mkdir -p $OBJDIR setenv THRD no # set to yes for OpenMP threading -if (${SITE} =~ cheyenne*) then +if (${MACHINE_ID} =~ cheyenne*) then setenv ARCH cheyenne_intel -else if (${SITE} =~ orion*) then +else if (${MACHINE_ID} =~ orion*) then setenv ARCH orion_intel -else if (${SITE} =~ hera*) then +else if (${MACHINE_ID} =~ hera*) then setenv ARCH hera_intel +else if (${MACHINE_ID} =~ wcoss*) then + setenv ARCH wcoss_dell_p3_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/machines/Macros.hera_intel b/configuration/scripts/machines/Macros.hera_intel index 230f43e70..caad25ead 100644 --- a/configuration/scripts/machines/Macros.hera_intel +++ b/configuration/scripts/machines/Macros.hera_intel @@ -4,11 +4,11 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +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 := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -xHost FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) @@ -48,9 +48,9 @@ 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 +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp endif diff --git a/configuration/scripts/machines/Macros.orion_intel b/configuration/scripts/machines/Macros.orion_intel index 6dffdd0a2..fa6745e03 100644 --- a/configuration/scripts/machines/Macros.orion_intel +++ b/configuration/scripts/machines/Macros.orion_intel @@ -4,11 +4,11 @@ CPP := fpp CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} -CFLAGS := -c -O2 -fp-model precise -xHost +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 := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -align array64byte -xHost FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) @@ -48,9 +48,9 @@ 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 +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp endif diff --git a/configuration/scripts/machines/Macros.wcoss_dell_p3_intel b/configuration/scripts/machines/Macros.wcoss_dell_p3_intel new file mode 100644 index 000000000..a835be424 --- /dev/null +++ b/configuration/scripts/machines/Macros.wcoss_dell_p3_intel @@ -0,0 +1,49 @@ +#============================================================================== +# Makefile macros for wcoss phase3 machine, 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 := icc +SFC := ifort +MPICC := mpiicc +MPIFC := mpiifort + +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 + +INC_NETCDF := $(NETCDF_PATH)/include +LIB_NETCDF := $(NETCDF_PATH)/lib + +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/options/set_nml.alt04 b/configuration/scripts/options/set_nml.alt04 index 937704294..e3689fe82 100644 --- a/configuration/scripts/options/set_nml.alt04 +++ b/configuration/scripts/options/set_nml.alt04 @@ -22,7 +22,7 @@ kevp_kernel = 102 fbot_xfer_type = 'Cdn_ocn' shortwave = 'dEdd' formdrag = .true. -advection = 'upwind' +advection = 'remap' kstrength = 0 krdg_partic = 0 krdg_redist = 0 diff --git a/configuration/scripts/tests/QC/cice.t-test.py b/configuration/scripts/tests/QC/cice.t-test.py index 86938d8e8..987175245 100755 --- a/configuration/scripts/tests/QC/cice.t-test.py +++ b/configuration/scripts/tests/QC/cice.t-test.py @@ -448,7 +448,12 @@ def plot_data(data, lat, lon, units, case, plot_type): # Make some room at the bottom of the figure, and create a colorbar fig.subplots_adjust(bottom=0.2) cbar_ax = fig.add_axes([0.11,0.1,0.8,0.05]) - cb = plt.colorbar(sc, cax=cbar_ax, orientation="horizontal", format="%.2f") + if '\n- ' in case: + # If making a difference plot, use scientific notation for colorbar + cb = plt.colorbar(sc, cax=cbar_ax, orientation="horizontal", format="%.2e") + else: + # If plotting non-difference data, do not use scientific notation for colorbar + cb = plt.colorbar(sc, cax=cbar_ax, orientation="horizontal", format="%.2f") cb.set_label(units, x=1.0) outfile = 'ice_thickness_{}.png'.format(case.replace('\n- ','_minus_')) diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 229fa92d5..1fb73c2d7 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -578,7 +578,7 @@ either Celsius or Kelvin units). "strairx(y)", "stress on ice by air in the x(y)-direction (centered in U cell)", "N/m\ :math:`^2`" "strairx(y)T", "stress on ice by air, x(y)-direction (centered in T cell)", "N/m\ :math:`^2`" "strax(y)", "wind stress components from data", "N/m\ :math:`^2`" - "strength", "ice strength (pressure)", "N/m" + "strength", "ice strength", "N/m" "stress12", "internal ice stress, :math:`\sigma_{12}`", "N/m" "stressm", "internal ice stress, :math:`\sigma_{11}-\sigma_{22}`", "N/m" "stressp", "internal ice stress, :math:`\sigma_{11}+\sigma_{22}`", "N/m" diff --git a/doc/source/conf.py b/doc/source/conf.py index 840ef4a44..8d0df9777 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'6.1.2' +version = u'6.1.3' # The full version, including alpha/beta/rc tags. -version = u'6.1.2' +version = u'6.1.3' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 0a48513dc..3551763b5 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -50,8 +50,9 @@ abort if set. To override the abort, use value 102 for testing. 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/**. Only the incremental +remapping method is supported at this time, and is set in namelist via the ``advection`` variable. +Transport can be turned off by setting ``advection = none`` or ``ktransport = -1``. Infrastructure diff --git a/doc/source/science_guide/sg_horiztrans.rst b/doc/source/science_guide/sg_horiztrans.rst index bafb4c72f..33b37564e 100644 --- a/doc/source/science_guide/sg_horiztrans.rst +++ b/doc/source/science_guide/sg_horiztrans.rst @@ -33,7 +33,7 @@ introductory comments in **ice\_transport\_remap.F90**. Prognostic equations for ice and/or snow density may be included in future model versions but have not yet been implemented. -Two transport schemes are available: upwind and the incremental +One transport scheme is available, the incremental remapping scheme of :cite:`Dukowicz00` as modified for sea ice by :cite:`Lipscomb04`. The remapping scheme has several desirable features: diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 550162515..032c8b529 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -358,13 +358,13 @@ dynamics_nml "", "", "", "" "``advection``", "``remap``", "linear remapping advection scheme", "``remap``" - "", "``upwind``", "donor cell advection", "" + "", "``none``", "advection off", "" "``alphab``", "real", ":math:`\alpha_{b}` factor in :cite:`Lemieux16`", "20.0" "``arlx``", "real", "revised_evp value", "300.0" "``brlx``", "real", "revised_evp value", "300.0" "``basalstress``", "logical", "use basal stress parameterization for landfast ice", "``.false.``" "``Cf``", "real", "ratio of ridging work to PE change in ridging", "17.0" - "``coriolis``", "``constant``", "constant coriolis value = 1.46e-4", "``latitude``" + "``coriolis``", "``constant``", "constant coriolis value = 1.46e-4 s\ :math:`^{-1}`", "``latitude``" "", "``latitude``", "coriolis variable by latitude", "" "", "``zero``", "zero coriolis", "" "``Cstar``", "real", "constant in Hibler strength formula", "20" diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 5369efe5f..d7e4a9fa4 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -228,7 +228,7 @@ boundary around the entire domain. It includes the following namelist modificat - ``dxrect``: ``16.e5`` cm - ``dyrect``: ``16.e5`` cm - ``ktherm``: ``-1`` (disables thermodynamics) -- ``coriolis``: ``zero`` (zero coriolis force) +- ``coriolis``: ``constant`` (``f=1.46e-4`` s\ :math:`^{-1}`) - ``ice_data_type`` : ``box2001`` (special ice concentration initialization) - ``atm_data_type`` : ``box2001`` (special atmospheric and ocean forcing) diff --git a/icepack b/icepack index 4c42a82e3..3b1ac0187 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 4c42a82e3d92f191a9c52bca3831e8d242e2e4c0 +Subproject commit 3b1ac0187ce30fbb950276b979376b041ca4467b From ac617cde36db5b41029d2c2523b0fb52c711897b Mon Sep 17 00:00:00 2001 From: Minsuk Ji <57227195+MinsukJi-NOAA@users.noreply.github.com> Date: Thu, 8 Oct 2020 07:13:14 -0400 Subject: [PATCH 28/44] Support TACC stampede (#19) --- .../forapps/ufs/comp_ice.backend.clean | 2 + .../forapps/ufs/comp_ice.backend.libcice | 2 + .../scripts/machines/Macros.stampede_intel | 56 +++++++++++++++++++ 3 files changed, 60 insertions(+) create mode 100644 configuration/scripts/machines/Macros.stampede_intel diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.clean b/configuration/scripts/forapps/ufs/comp_ice.backend.clean index af6cfe9ab..d75d381b4 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.clean +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.clean @@ -16,6 +16,8 @@ else if (${MACHINE_ID} =~ hera*) then setenv ARCH hera_intel else if (${MACHINE_ID} =~ wcoss*) then setenv ARCH wcoss_dell_p3_intel +else if (${MACHINE_ID} =~ stampede*) then + setenv ARCH stampede_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice index 1b5b142a5..47985bef2 100755 --- a/configuration/scripts/forapps/ufs/comp_ice.backend.libcice +++ b/configuration/scripts/forapps/ufs/comp_ice.backend.libcice @@ -24,6 +24,8 @@ else if (${MACHINE_ID} =~ hera*) then setenv ARCH hera_intel else if (${MACHINE_ID} =~ wcoss*) then setenv ARCH wcoss_dell_p3_intel +else if (${MACHINE_ID} =~ stampede*) then + setenv ARCH stampede_intel else echo "CICE6 ${0}: ERROR in ARCH setup, ${hname}" exit -2 diff --git a/configuration/scripts/machines/Macros.stampede_intel b/configuration/scripts/machines/Macros.stampede_intel new file mode 100644 index 000000000..14bbc7a4a --- /dev/null +++ b/configuration/scripts/machines/Macros.stampede_intel @@ -0,0 +1,56 @@ +#============================================================================== +# Makefile macros for TACC stampede, 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 := icc +SFC := ifort +MPICC := mpiicc +MPIFC := mpiifort + +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD:= $(FC) + +NETCDF_PATH := $(NETCDF_ROOT) + +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 + From 1e4f42bcd2a11cac6fda8b2a49a7af45a41c459f Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 30 Oct 2020 11:13:17 -0400 Subject: [PATCH 29/44] update icepack --- .gitmodules | 2 +- icepack | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8a773d230..c095cc774 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "icepack"] path = icepack - url = https://github.com/NOAA-EMC/Icepack + url = https://github.com/DeniseWorthen/Icepack diff --git a/icepack b/icepack index 3b1ac0187..f11d17a01 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 3b1ac0187ce30fbb950276b979376b041ca4467b +Subproject commit f11d17a01472ce2ddfb77dbbf8ef8432114aa1ba From 41afe74306043b904ec6529f1d0bc2ec89293feb Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 30 Oct 2020 17:47:51 +0000 Subject: [PATCH 30/44] add ice_dyn_vp module to CICE_InitMod --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 29 ++++++++++--------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index cb70c9b4a..b37d73f65 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -53,6 +53,7 @@ subroutine cice_init use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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 @@ -162,8 +163,8 @@ subroutine cice_init call faero_optics !initialize aerosol optical property tables end if - ! Initialize shortwave components using swdn from previous timestep - ! if restarting. These components will be scaled to current forcing + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing ! in prep_radiation. if (trim(runtype) == 'continue' .or. restart) then @@ -250,7 +251,7 @@ subroutine init_restart if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (trim(runtype) == 'continue') then + if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in call calendar(time) ! update time parameters @@ -261,17 +262,17 @@ subroutine init_restart ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file !!! uncomment if EAP restart data exists ! if (kdyn == 2) call read_restart_eap - endif + endif ! tracers - ! ice age tracer - if (tr_iage) then + ! ice age tracer + if (tr_iage) then if (trim(runtype) == 'continue') & restart_age = .true. if (restart_age) then call read_restart_age else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_age(trcrn(:,:,nt_iage,:,iblk)) enddo ! iblk endif @@ -282,7 +283,7 @@ subroutine init_restart if (restart_FY) then call read_restart_FY else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_FY(trcrn(:,:,nt_FY,:,iblk)) enddo ! iblk endif @@ -293,7 +294,7 @@ subroutine init_restart if (restart_lvl) then call read_restart_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & trcrn(:,:,nt_vlvl,:,iblk)) enddo ! iblk @@ -306,7 +307,7 @@ subroutine init_restart if (restart_pond_cesm) then call read_restart_pond_cesm else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_cesm(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk)) enddo ! iblk @@ -319,7 +320,7 @@ subroutine init_restart if (restart_pond_lvl) then call read_restart_pond_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk), & @@ -334,7 +335,7 @@ subroutine init_restart if (restart_pond_topo) then call read_restart_pond_topo else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk)) @@ -357,7 +358,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 @@ -369,7 +370,7 @@ subroutine init_restart if (restart_aero) then call read_restart_aero else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) enddo ! iblk endif ! .not. restart_aero From 2a0f3329b3dbea40b70a03830ce1cb6e86d6d8b0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 10 Nov 2020 10:29:03 -0500 Subject: [PATCH 31/44] update gitmodules, update icepack --- .gitmodules | 2 +- icepack | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index c095cc774..8a773d230 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,3 @@ [submodule "icepack"] path = icepack - url = https://github.com/DeniseWorthen/Icepack + url = https://github.com/NOAA-EMC/Icepack diff --git a/icepack b/icepack index f11d17a01..db2a47789 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit f11d17a01472ce2ddfb77dbbf8ef8432114aa1ba +Subproject commit db2a4778970ae340b6bdd62eb03f60cd37a13f75 From f773ef3892615da4b4af26b4be3e57c9f29b9343 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 10 Nov 2020 10:37:11 -0500 Subject: [PATCH 32/44] Update CICE to consortium master (#23) updates include: * deprecate upwind advection (CICE-Consortium#508) * add implicit VP solver (CICE-Consortium#491) --- cicecore/cicedynB/dynamics/ice_dyn_eap.F90 | 44 +- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 115 +- cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 | 4 +- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 280 +- cicecore/cicedynB/dynamics/ice_dyn_vp.F90 | 3689 +++++++++++++++++ cicecore/cicedynB/general/ice_forcing.F90 | 14 +- cicecore/cicedynB/general/ice_init.F90 | 150 +- cicecore/cicedynB/general/ice_step_mod.F90 | 4 +- .../comm/mpi/ice_global_reductions.F90 | 72 +- .../comm/serial/ice_global_reductions.F90 | 72 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 1 + .../drivers/direct/hadgem3/CICE_InitMod.F90 | 10 +- .../drivers/direct/hadgem3/CICE_RunMod.F90 | 5 + cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 10 +- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 5 + cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 38 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 9 +- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 5 + .../drivers/standalone/cice/CICE_InitMod.F90 | 10 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 3 +- .../standalone/cice/CICE_RunMod.F90_debug | 5 + cicecore/shared/ice_fileunits.F90 | 1 - configuration/scripts/ice_in | 15 + .../scripts/machines/Macros.banting_intel | 2 +- .../scripts/machines/Macros.cesium_intel | 4 +- .../scripts/machines/Macros.conda_linux | 2 +- .../scripts/machines/Macros.conda_macos | 2 +- .../scripts/machines/Macros.daley_intel | 2 +- .../scripts/machines/Macros.fram_intel | 2 +- .../scripts/machines/Macros.millikan_intel | 2 +- .../scripts/machines/environment.yml | 1 + configuration/scripts/options/set_env.lapack | 1 + configuration/scripts/options/set_nml.diagimp | 3 + .../scripts/options/set_nml.dynanderson | 3 + .../scripts/options/set_nml.dynpicard | 3 + .../scripts/options/set_nml.nonlin5000 | 1 + configuration/scripts/options/set_nml.run3dt | 6 + configuration/scripts/tests/base_suite.ts | 1 + doc/source/cice_index.rst | 2 +- doc/source/developer_guide/dg_driver.rst | 7 +- doc/source/developer_guide/dg_dynamics.rst | 10 +- doc/source/master_list.bib | 27 + doc/source/science_guide/sg_dynamics.rst | 228 +- doc/source/user_guide/ug_case_settings.rst | 19 + icepack | 2 +- 45 files changed, 4622 insertions(+), 269 deletions(-) create mode 100644 cicecore/cicedynB/dynamics/ice_dyn_vp.F90 create mode 100644 configuration/scripts/options/set_env.lapack create mode 100644 configuration/scripts/options/set_nml.diagimp create mode 100644 configuration/scripts/options/set_nml.dynanderson create mode 100644 configuration/scripts/options/set_nml.dynpicard create mode 100644 configuration/scripts/options/set_nml.nonlin5000 create mode 100644 configuration/scripts/options/set_nml.run3dt diff --git a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 index 3b31fa8cd..e6bb86bff 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_eap.F90 @@ -122,7 +122,8 @@ subroutine eap (dt) use ice_dyn_shared, only: fcor_blk, ndte, dtei, & denom1, uvel_init, vvel_init, arlx1i, & dyn_prep1, dyn_prep2, stepu, dyn_finish, & - basal_stress_coeff, basalstress + basal_stress_coeff, basalstress, & + stack_velocity_field, unstack_velocity_field use ice_flux, only: rdg_conv, strairxT, strairyT, & strairx, strairy, uocn, vocn, ss_tltx, ss_tlty, iceumask, fm, & strtltx, strtlty, strocnx, strocny, strintx, strinty, taubx, tauby, & @@ -354,11 +355,6 @@ subroutine eap (dt) vicen = vicen (i,j,:,iblk), & strength = strength(i,j, iblk) ) enddo ! ij - - ! load velocity into array for boundary updates - fld2(:,:,1,iblk) = uvel(:,:,iblk) - fld2(:,:,2,iblk) = vvel(:,:,iblk) - enddo ! iblk !$TCXOMP END PARALLEL DO @@ -370,18 +366,12 @@ subroutine eap (dt) call ice_HaloUpdate (strength, halo_info, & field_loc_center, field_type_scalar) ! velocities may have changed in dyn_prep2 + call stack_velocity_field(uvel, vvel, fld2) call ice_HaloUpdate (fld2, halo_info, & field_loc_NEcorner, field_type_vector) + call unstack_velocity_field(fld2, uvel, vvel) call ice_timer_stop(timer_bound) - ! unload - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - uvel(:,:,iblk) = fld2(:,:,1,iblk) - vvel(:,:,iblk) = fld2(:,:,2,iblk) - enddo - !$OMP END PARALLEL DO - if (maskhalo_dyn) then call ice_timer_start(timer_bound) halomask = 0 @@ -472,10 +462,6 @@ subroutine eap (dt) uvel (:,:,iblk), vvel (:,:,iblk), & Tbu (:,:,iblk)) - ! load velocity into array for boundary updates - fld2(:,:,1,iblk) = uvel(:,:,iblk) - fld2(:,:,2,iblk) = vvel(:,:,iblk) - !----------------------------------------------------------------- ! evolution of structure tensor A !----------------------------------------------------------------- @@ -501,6 +487,7 @@ subroutine eap (dt) 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, & @@ -510,14 +497,7 @@ subroutine eap (dt) field_loc_NEcorner, field_type_vector) endif call ice_timer_stop(timer_bound) - - ! unload - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - uvel(:,:,iblk) = fld2(:,:,1,iblk) - vvel(:,:,iblk) = fld2(:,:,2,iblk) - enddo - !$OMP END PARALLEL DO + call unstack_velocity_field(fld2, uvel, vvel) enddo ! subcycling @@ -556,16 +536,12 @@ end subroutine eap !======================================================================= ! Initialize parameters and variables needed for the eap dynamics -! (based on init_evp) +! (based on init_dyn) - subroutine init_eap (dt) + subroutine init_eap use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks - use ice_dyn_shared, only: init_evp - - real (kind=dbl_kind), intent(in) :: & - dt ! time step ! local variables @@ -595,8 +571,6 @@ subroutine init_eap (dt) file=__FILE__, line=__LINE__) phi = pi/c12 ! diamond shaped floe smaller angle (default phi = 30 deg) - call init_evp (dt) - !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block @@ -1321,7 +1295,7 @@ subroutine stress_eap (nx_block, ny_block, & tensionse = -cym(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + cxp(i,j)*vvel(i ,j-1) - dxt(i,j)*vvel(i ,j ) - ! shearing strain rate = e_12 + ! shearing strain rate = 2*e_12 shearne = -cym(i,j)*vvel(i ,j ) - dyt(i,j)*vvel(i-1,j ) & - cxm(i,j)*uvel(i ,j ) - dxt(i,j)*uvel(i ,j-1) shearnw = -cyp(i,j)*vvel(i-1,j ) + dyt(i,j)*vvel(i ,j ) & diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index 0f8acd547..5846cf143 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -94,7 +94,7 @@ subroutine evp (dt) 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 + use ice_dyn_shared, only: kevp_kernel, stack_velocity_field, unstack_velocity_field real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -297,10 +297,6 @@ subroutine evp (dt) strength = strength(i,j, iblk) ) enddo ! ij - ! load velocity into array for boundary updates - fld2(:,:,1,iblk) = uvel(:,:,iblk) - fld2(:,:,2,iblk) = vvel(:,:,iblk) - enddo ! iblk !$TCXOMP END PARALLEL DO @@ -312,18 +308,12 @@ subroutine evp (dt) call ice_HaloUpdate (strength, halo_info, & field_loc_center, field_type_scalar) ! velocities may have changed in dyn_prep2 + call stack_velocity_field(uvel, vvel, fld2) call ice_HaloUpdate (fld2, halo_info, & field_loc_NEcorner, field_type_vector) + call unstack_velocity_field(fld2, uvel, vvel) call ice_timer_stop(timer_bound) - ! unload - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - uvel(:,:,iblk) = fld2(:,:,1,iblk) - vvel(:,:,iblk) = fld2(:,:,2,iblk) - enddo - !$OMP END PARALLEL DO - if (maskhalo_dyn) then call ice_timer_start(timer_bound) halomask = 0 @@ -442,13 +432,10 @@ subroutine evp (dt) uvel_init(:,:,iblk), vvel_init(:,:,iblk),& uvel (:,:,iblk), vvel (:,:,iblk), & Tbu (:,:,iblk)) - - ! load velocity into array for boundary updates - fld2(:,:,1,iblk) = uvel(:,:,iblk) - fld2(:,:,2,iblk) = vvel(:,:,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, & @@ -458,14 +445,7 @@ subroutine evp (dt) field_loc_NEcorner, field_type_vector) endif call ice_timer_stop(timer_bound) - - ! unload - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - uvel(:,:,iblk) = fld2(:,:,1,iblk) - vvel(:,:,iblk) = fld2(:,:,2,iblk) - enddo - !$OMP END PARALLEL DO + call unstack_velocity_field(fld2, uvel, vvel) enddo ! subcycling endif ! kevp_kernel @@ -599,6 +579,8 @@ subroutine stress (nx_block, ny_block, & rdg_conv, rdg_shear, & str ) + use ice_dyn_shared, only: strain_rates, deformations + integer (kind=int_kind), intent(in) :: & nx_block, ny_block, & ! block dimensions ksub , & ! subcycling step @@ -676,58 +658,20 @@ subroutine stress (nx_block, ny_block, & ! strain rates ! NOTE these are actually strain rates * area (m^2/s) !----------------------------------------------------------------- - ! divergence = e_11 + e_22 - divune = cyp(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & - + cxp(i,j)*vvel(i ,j ) - dxt(i,j)*vvel(i ,j-1) - divunw = cym(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & - + cxp(i,j)*vvel(i-1,j ) - dxt(i,j)*vvel(i-1,j-1) - divusw = cym(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & - + cxm(i,j)*vvel(i-1,j-1) + dxt(i,j)*vvel(i-1,j ) - divuse = cyp(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & - + cxm(i,j)*vvel(i ,j-1) + dxt(i,j)*vvel(i ,j ) - - ! tension strain rate = e_11 - e_22 - tensionne = -cym(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & - + cxm(i,j)*vvel(i ,j ) + dxt(i,j)*vvel(i ,j-1) - tensionnw = -cyp(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & - + cxm(i,j)*vvel(i-1,j ) + dxt(i,j)*vvel(i-1,j-1) - tensionsw = -cyp(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & - + cxp(i,j)*vvel(i-1,j-1) - dxt(i,j)*vvel(i-1,j ) - tensionse = -cym(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & - + cxp(i,j)*vvel(i ,j-1) - dxt(i,j)*vvel(i ,j ) - - ! shearing strain rate = e_12 - shearne = -cym(i,j)*vvel(i ,j ) - dyt(i,j)*vvel(i-1,j ) & - - cxm(i,j)*uvel(i ,j ) - dxt(i,j)*uvel(i ,j-1) - shearnw = -cyp(i,j)*vvel(i-1,j ) + dyt(i,j)*vvel(i ,j ) & - - cxm(i,j)*uvel(i-1,j ) - dxt(i,j)*uvel(i-1,j-1) - shearsw = -cyp(i,j)*vvel(i-1,j-1) + dyt(i,j)*vvel(i ,j-1) & - - cxp(i,j)*uvel(i-1,j-1) + dxt(i,j)*uvel(i-1,j ) - shearse = -cym(i,j)*vvel(i ,j-1) - dyt(i,j)*vvel(i-1,j-1) & - - cxp(i,j)*uvel(i ,j-1) + dxt(i,j)*uvel(i ,j ) - - ! 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)) - 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 - !----------------------------------------------------------------- - if (ksub == ndte) then - divu(i,j) = p25*(divune + divunw + divuse + divusw) * tarear(i,j) - tmp = p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(i,j) - rdg_conv(i,j) = -min(divu(i,j),c0) - rdg_shear(i,j) = p5*(tmp-abs(divu(i,j))) - - ! diagnostic only - ! shear = sqrt(tension**2 + shearing**2) - shear(i,j) = p25*tarear(i,j)*sqrt( & - (tensionne + tensionnw + tensionse + tensionsw)**2 & - + (shearne + shearnw + shearse + shearsw)**2) - - endif + call strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) !----------------------------------------------------------------- ! strength/Delta ! kg/s @@ -902,6 +846,23 @@ subroutine stress (nx_block, ny_block, & enddo ! ij + !----------------------------------------------------------------- + ! on last subcycle, save quantities for mechanical redistribution + !----------------------------------------------------------------- + if (ksub == ndte) then + call deformations (nx_block , ny_block , & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + tarear , & + shear , divu , & + rdg_conv , rdg_shear ) + + endif + end subroutine stress !======================================================================= diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 index c88a7de3a..9fac97a89 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 @@ -326,7 +326,7 @@ subroutine stress_i(NA_len, & ! 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 = e_12 + ! 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) @@ -614,7 +614,7 @@ subroutine stress_l(NA_len, tarear, & tensionse = -cym*tmp_uvel_se - dyt(iw)*tmp_uvel_ne & + cxp*tmp_vvel_se - dxt(iw)*vvel(iw) - ! shearing strain rate = e_12 + ! 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) & diff --git a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 index c3dc83a24..d9a0919e6 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_shared.F90 @@ -22,9 +22,10 @@ module ice_dyn_shared implicit none private - public :: init_evp, set_evp_parameters, stepu, principal_stress, & + public :: init_dyn, set_evp_parameters, stepu, principal_stress, & dyn_prep1, dyn_prep2, dyn_finish, basal_stress_coeff, & - alloc_dyn_shared + alloc_dyn_shared, deformations, strain_rates, & + stack_velocity_field, unstack_velocity_field ! namelist parameters @@ -78,7 +79,7 @@ module ice_dyn_shared real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & uvel_init, & ! x-component of velocity (m/s), beginning of timestep vvel_init ! y-component of velocity (m/s), beginning of timestep - + ! ice isotropic tensile strength parameter real (kind=dbl_kind), public :: & Ktens ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) @@ -91,9 +92,9 @@ module ice_dyn_shared k1, & ! 1st free parameter for landfast parameterization k2, & ! second free parameter (N/m^3) for landfast 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) - + threshold_hw, & ! max water depth for grounding + ! see keel data from Amundrud et al. 2004 (JGR) + u0 = 5e-5_dbl_kind ! residual velocity for basal stress (m/s) !======================================================================= @@ -117,10 +118,10 @@ end subroutine alloc_dyn_shared !======================================================================= -! Initialize parameters and variables needed for the evp dynamics +! Initialize parameters and variables needed for the dynamics ! author: Elizabeth C. Hunke, LANL - subroutine init_evp (dt) + subroutine init_dyn (dt) use ice_blocks, only: nx_block, ny_block use ice_domain, only: nblocks @@ -141,7 +142,7 @@ subroutine init_evp (dt) i, j, & iblk ! block index - character(len=*), parameter :: subname = '(init_evp)' + character(len=*), parameter :: subname = '(init_dyn)' call set_evp_parameters (dt) @@ -199,7 +200,7 @@ subroutine init_evp (dt) enddo ! iblk !$OMP END PARALLEL DO - end subroutine init_evp + end subroutine init_dyn !======================================================================= @@ -690,9 +691,6 @@ subroutine stepu (nx_block, ny_block, & Cb , & ! complete basal stress coeff rhow ! - real (kind=dbl_kind) :: & - u0 = 5e-5_dbl_kind ! residual velocity for basal stress (m/s) - character(len=*), parameter :: subname = '(stepu)' !----------------------------------------------------------------- @@ -993,6 +991,262 @@ end subroutine principal_stress !======================================================================= +! Compute deformations for mechanical redistribution +! +! author: Elizabeth C. Hunke, LANL +! +! 2019: subroutine created by Philippe Blain, ECCC + + subroutine deformations (nx_block, ny_block, & + icellt, & + indxti, indxtj, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + tarear, & + shear, divu, & + rdg_conv, rdg_shear ) + + use ice_constants, only: p25, p5 + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), & + intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + 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 + tarear ! 1/tarea + + real (kind=dbl_kind), dimension (nx_block,ny_block), & + intent(inout) :: & + shear , & ! strain rate II component (1/s) + divu , & ! strain rate I component, velocity divergence (1/s) + rdg_conv , & ! convergence term for ridging (1/s) + rdg_shear ! shear term for ridging (1/s) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & ! at each corner : + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delta + tmp ! useful combination + + character(len=*), parameter :: subname = '(deformations)' + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) + !----------------------------------------------------------------- + ! deformations for mechanical redistribution + !----------------------------------------------------------------- + divu(i,j) = p25*(divune + divunw + divuse + divusw) * tarear(i,j) + tmp = p25*(Deltane + Deltanw + Deltase + Deltasw) * tarear(i,j) + rdg_conv(i,j) = -min(divu(i,j),c0) + rdg_shear(i,j) = p5*(tmp-abs(divu(i,j))) + + ! diagnostic only + ! shear = sqrt(tension**2 + shearing**2) + shear(i,j) = p25*tarear(i,j)*sqrt( & + (tensionne + tensionnw + tensionse + tensionsw)**2 + & + (shearne + shearnw + shearse + shearsw )**2) + + enddo ! ij + + end subroutine deformations + +!======================================================================= + +! Compute strain rates +! +! author: Elizabeth C. Hunke, LANL +! +! 2019: subroutine created by Philippe Blain, ECCC + + subroutine strain_rates (nx_block, ny_block, & + i, j, & + uvel, vvel, & + dxt, dyt, & + cxp, cyp, & + cxm, cym, & + divune, divunw, & + divuse, divusw, & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne, shearnw, & + shearse, shearsw, & + Deltane, Deltanw, & + Deltase, Deltasw ) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block ! block dimensions + + integer (kind=int_kind) :: & + i, j ! indices + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + 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 + + real (kind=dbl_kind), intent(out):: & ! at each corner : + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw ! Delta + + character(len=*), parameter :: subname = '(strain_rates)' + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + + ! divergence = e_11 + e_22 + divune = cyp(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxp(i,j)*vvel(i ,j ) - dxt(i,j)*vvel(i ,j-1) + divunw = cym(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxp(i,j)*vvel(i-1,j ) - dxt(i,j)*vvel(i-1,j-1) + divusw = cym(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxm(i,j)*vvel(i-1,j-1) + dxt(i,j)*vvel(i-1,j ) + divuse = cyp(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxm(i,j)*vvel(i ,j-1) + dxt(i,j)*vvel(i ,j ) + + ! tension strain rate = e_11 - e_22 + tensionne = -cym(i,j)*uvel(i ,j ) - dyt(i,j)*uvel(i-1,j ) & + + cxm(i,j)*vvel(i ,j ) + dxt(i,j)*vvel(i ,j-1) + tensionnw = -cyp(i,j)*uvel(i-1,j ) + dyt(i,j)*uvel(i ,j ) & + + cxm(i,j)*vvel(i-1,j ) + dxt(i,j)*vvel(i-1,j-1) + tensionsw = -cyp(i,j)*uvel(i-1,j-1) + dyt(i,j)*uvel(i ,j-1) & + + cxp(i,j)*vvel(i-1,j-1) - dxt(i,j)*vvel(i-1,j ) + tensionse = -cym(i,j)*uvel(i ,j-1) - dyt(i,j)*uvel(i-1,j-1) & + + cxp(i,j)*vvel(i ,j-1) - dxt(i,j)*vvel(i ,j ) + + ! shearing strain rate = 2*e_12 + shearne = -cym(i,j)*vvel(i ,j ) - dyt(i,j)*vvel(i-1,j ) & + - cxm(i,j)*uvel(i ,j ) - dxt(i,j)*uvel(i ,j-1) + shearnw = -cyp(i,j)*vvel(i-1,j ) + dyt(i,j)*vvel(i ,j ) & + - cxm(i,j)*uvel(i-1,j ) - dxt(i,j)*uvel(i-1,j-1) + shearsw = -cyp(i,j)*vvel(i-1,j-1) + dyt(i,j)*vvel(i ,j-1) & + - cxp(i,j)*uvel(i-1,j-1) + dxt(i,j)*uvel(i-1,j ) + shearse = -cym(i,j)*vvel(i ,j-1) - dyt(i,j)*vvel(i-1,j-1) & + - cxp(i,j)*uvel(i ,j-1) + dxt(i,j)*uvel(i ,j ) + + ! 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)) + Deltasw = sqrt(divusw**2 + ecci*(tensionsw**2 + shearsw**2)) + Deltase = sqrt(divuse**2 + ecci*(tensionse**2 + shearse**2)) + + end subroutine strain_rates + +!======================================================================= + +! Load velocity components into array for boundary updates + + subroutine stack_velocity_field(uvel, vvel, fld2) + + use ice_domain, only: nblocks + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + uvel , & ! u components of velocity vector + vvel ! v components of velocity vector + + real (kind=dbl_kind), dimension (nx_block,ny_block,2,max_blocks), intent(out) :: & + fld2 ! work array for boundary updates + + ! local variables + + integer (kind=int_kind) :: & + iblk ! block index + + character(len=*), parameter :: subname = '(stack_velocity_field)' + + ! load velocity into array for boundary updates + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + fld2(:,:,1,iblk) = uvel(:,:,iblk) + fld2(:,:,2,iblk) = vvel(:,:,iblk) + enddo + !$OMP END PARALLEL DO + + end subroutine stack_velocity_field + +!======================================================================= + +! Unload velocity components from array after boundary updates + + subroutine unstack_velocity_field(fld2, uvel, vvel) + + use ice_domain, only: nblocks + + real (kind=dbl_kind), dimension (nx_block,ny_block,2,max_blocks), intent(in) :: & + fld2 ! work array for boundary updates + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(out) :: & + uvel , & ! u components of velocity vector + vvel ! v components of velocity vector + + ! local variables + + integer (kind=int_kind) :: & + iblk ! block index + + character(len=*), parameter :: subname = '(unstack_velocity_field)' + + ! Unload velocity from array after boundary updates + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + uvel(:,:,iblk) = fld2(:,:,1,iblk) + vvel(:,:,iblk) = fld2(:,:,2,iblk) + enddo + !$OMP END PARALLEL DO + + end subroutine unstack_velocity_field + +!======================================================================= + end module ice_dyn_shared !======================================================================= diff --git a/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 new file mode 100644 index 000000000..570e202c2 --- /dev/null +++ b/cicecore/cicedynB/dynamics/ice_dyn_vp.F90 @@ -0,0 +1,3689 @@ +!======================================================================= +! +! Viscous-plastic sea ice dynamics model +! Computes ice velocity and deformation +! +! See: +! +! Lemieux, J.‐F., Tremblay, B., Thomas, S., Sedláček, J., and Mysak, L. A. (2008), +! Using the preconditioned Generalized Minimum RESidual (GMRES) method to solve +! the sea‐ice momentum equation, J. Geophys. Res., 113, C10004, doi:10.1029/2007JC004680. +! +! Hibler, W. D., and Ackley, S. F. (1983), Numerical simulation of the Weddell Sea pack ice, +! J. Geophys. Res., 88( C5), 2873– 2887, doi:10.1029/JC088iC05p02873. +! +! Y. Saad. A Flexible Inner-Outer Preconditioned GMRES Algorithm. SIAM J. Sci. Comput., +! 14(2):461–469, 1993. URL: https://doi.org/10.1137/0914028, doi:10.1137/0914028. +! +! C. T. Kelley, Iterative Methods for Linear and Nonlinear Equations, SIAM, 1995. +! (https://www.siam.org/books/textbooks/fr16_book.pdf) +! +! Y. Saad, Iterative Methods for Sparse Linear Systems. SIAM, 2003. +! (http://www-users.cs.umn.edu/~saad/IterMethBook_2ndEd.pdf) +! +! Walker, H. F., & Ni, P. (2011). Anderson Acceleration for Fixed-Point Iterations. +! SIAM Journal on Numerical Analysis, 49(4), 1715–1735. https://doi.org/10.1137/10078356X +! +! Fang, H., & Saad, Y. (2009). Two classes of multisecant methods for nonlinear acceleration. +! Numerical Linear Algebra with Applications, 16(3), 197–221. https://doi.org/10.1002/nla.617 +! +! Birken, P. (2015) Termination criteria for inexact fixed‐point schemes. +! Numer. Linear Algebra Appl., 22: 702– 716. doi: 10.1002/nla.1982. +! +! authors: JF Lemieux, ECCC, Philppe Blain, ECCC +! + + module ice_dyn_vp + + use ice_kinds_mod + use ice_blocks, only: nx_block, ny_block + use ice_boundary, only: ice_halo + use ice_communicate, only: my_task, master_task, get_num_procs + 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, & + p222, p25, p333, p5, c1 + use ice_domain, only: nblocks, distrb_info + use ice_domain_size, only: max_blocks + use ice_dyn_shared, only: dyn_prep1, dyn_prep2, dyn_finish, & + ecci, cosw, sinw, fcor_blk, uvel_init, & + vvel_init, basal_stress_coeff, basalstress, Ktens, & + stack_velocity_field, unstack_velocity_field + use ice_fileunits, only: nu_diag + use ice_flux, only: fm + use ice_global_reductions, only: global_sum, global_allreduce_sum + use ice_grid, only: dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, uarear + use ice_exit, only: abort_ice + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_ice_strength, icepack_query_parameters + + implicit none + private + public :: implicit_solver, init_vp + + ! namelist parameters + + integer (kind=int_kind), public :: & + maxits_nonlin , & ! max nb of iteration for nonlinear solver + dim_fgmres , & ! size of fgmres Krylov subspace + dim_pgmres , & ! size of pgmres Krylov subspace + maxits_fgmres , & ! max nb of iteration for fgmres + maxits_pgmres , & ! max nb of iteration for pgmres + fpfunc_andacc , & ! fixed point function for Anderson acceleration: 1: g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x) + dim_andacc , & ! size of Anderson minimization matrix (number of saved previous residuals) + start_andacc ! acceleration delay factor (acceleration starts at this iteration) + + logical (kind=log_kind), public :: & + monitor_nonlin , & ! print nonlinear residual norm + monitor_fgmres , & ! print fgmres residual norm + monitor_pgmres , & ! print pgmres residual norm + use_mean_vrel ! use mean of previous 2 iterates to compute vrel (see Hibler and Ackley 1983) + + real (kind=dbl_kind), public :: & + reltol_nonlin , & ! nonlinear stopping criterion: reltol_nonlin*res(k=0) + reltol_fgmres , & ! fgmres stopping criterion: reltol_fgmres*res(k) + reltol_pgmres , & ! pgmres stopping criterion: reltol_pgmres*res(k) + damping_andacc , & ! damping factor for Anderson acceleration + reltol_andacc ! relative tolerance for Anderson acceleration + + character (len=char_len), public :: & + precond , & ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres' (Jacobi-preconditioned GMRES) + algo_nonlin , & ! nonlinear algorithm: 'picard' (Picard iteration), 'anderson' (Anderson acceleration) + ortho_type ! type of orthogonalization for FGMRES ('cgs' or 'mgs') + + ! module variables + + integer (kind=int_kind), allocatable :: & + icellt(:) , & ! no. of cells where icetmask = 1 + icellu(:) ! no. of cells where iceumask = 1 + + integer (kind=int_kind), allocatable :: & + indxti(:,:) , & ! compressed index in i-direction + indxtj(:,:) , & ! compressed index in j-direction + indxui(:,:) , & ! compressed index in i-direction + indxuj(:,:) ! compressed index in j-direction + + real (kind=dbl_kind), allocatable :: & + fld2(:,:,:,:) ! work array for boundary updates + +!======================================================================= + + contains + +!======================================================================= + +! Initialize parameters and variables needed for the vp dynamics +! author: Philippe Blain, ECCC + + subroutine init_vp + + use ice_blocks, only: get_block, block + use ice_boundary, only: ice_HaloUpdate + use ice_constants, only: c1, & + field_loc_center, field_type_scalar + use ice_domain, only: blocks_ice, halo_info + use ice_grid, only: tarea, tinyarea + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, & + ilo,ihi,jlo,jhi ! beginning and end of physical domain + + type (block) :: & + this_block ! block information for current block + + real (kind=dbl_kind) :: & + min_strain_rate = 2e-09_dbl_kind ! used for recomputing tinyarea + + ! Initialize module variables + allocate(icellt(max_blocks), icellu(max_blocks)) + allocate(indxti(nx_block*ny_block, max_blocks), & + indxtj(nx_block*ny_block, max_blocks), & + indxui(nx_block*ny_block, max_blocks), & + indxuj(nx_block*ny_block, max_blocks)) + allocate(fld2(nx_block,ny_block,2,max_blocks)) + + ! Redefine tinyarea using min_strain_rate + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + do j = jlo, jhi + do i = ilo, ihi + tinyarea(i,j,iblk) = min_strain_rate*tarea(i,j,iblk) + enddo + enddo + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_HaloUpdate (tinyarea, halo_info, & + field_loc_center, field_type_scalar, & + fillValue=c1) + + end subroutine init_vp + +!======================================================================= + +! Viscous-plastic dynamics driver +! +#ifdef CICE_IN_NEMO +! Wind stress is set during this routine from the values supplied +! via NEMO (unless calc_strair is true). These values are supplied +! rotated on u grid and multiplied by aice. strairxT = 0 in this +! case so operations in dyn_prep1 are pointless but carried out to +! minimise code changes. +#endif +! +! author: JF Lemieux, A. Qaddouri and F. Dupont ECCC + + subroutine implicit_solver (dt) + + use ice_arrays_column, only: Cdn_ocn + use ice_boundary, only: ice_HaloMask, ice_HaloUpdate, & + ice_HaloDestroy, ice_HaloUpdate_stress + use ice_blocks, only: block, get_block, nx_block, ny_block + use ice_domain, only: blocks_ice, halo_info, maskhalo_dyn + use ice_domain_size, only: max_blocks, ncat + use ice_dyn_shared, only: deformations + use ice_flux, only: rdg_conv, rdg_shear, strairxT, strairyT, & + strairx, strairy, uocn, vocn, ss_tltx, ss_tlty, iceumask, fm, & + strtltx, strtlty, strocnx, strocny, strintx, strinty, taubx, tauby, & + strocnxT, strocnyT, strax, stray, & + Tbu, hwater, & + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1, stress12_2, stress12_3, stress12_4 + use ice_grid, only: tmask, umask, dxt, dyt, cxp, cyp, cxm, cym, & + tarear, to_ugrid, t2ugrid_vector, u2tgrid_vector, & + 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 + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + ntot , & ! size of problem for Anderson + iblk , & ! block index + ilo,ihi,jlo,jhi, & ! beginning and end of physical domain + i, j, ij + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + tmass , & ! total mass of ice and snow (kg/m^2) + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey , & ! work array: combined atm stress and ocn tilt, y + bxfix , & ! part of bx that is constant during Picard + byfix , & ! part of by that is constant during Picard + Cb , & ! seabed stress coefficient + fpresx , & ! fixed point residual vector, x components: fx = uvel - uprev_k + fpresy , & ! fixed point residual vector, y components: fy = vvel - vprev_k + aiu , & ! ice fraction on u-grid + umass , & ! total mass of ice and snow (u grid) + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4):: & + zetaD ! zetaD = 2zeta (viscous coeff) + + logical (kind=log_kind) :: calc_strair + + integer (kind=int_kind), dimension (nx_block,ny_block,max_blocks) :: & + icetmask, & ! ice extent mask (T-cell) + halomask ! generic halo mask + + type (ice_halo) :: & + halo_info_mask ! ghost cell update info for masked halo + + type (block) :: & + this_block ! block information for current block + + real (kind=dbl_kind), allocatable :: & + sol(:) ! solution vector + + character(len=*), parameter :: subname = '(implicit_solver)' + + call ice_timer_start(timer_dynamics) ! dynamics + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + ! This call is needed only if dt changes during runtime. +! call set_evp_parameters (dt) + + !----------------------------------------------------------------- + ! boundary updates + ! commented out because the ghost cells are freshly + ! updated after cleanup_itd + !----------------------------------------------------------------- + +! call ice_timer_start(timer_bound) +! call ice_HaloUpdate (aice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vice, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_HaloUpdate (vsno, halo_info, & +! field_loc_center, field_type_scalar) +! call ice_timer_stop(timer_bound) + + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + do j = 1, ny_block + do i = 1, nx_block + rdg_conv (i,j,iblk) = c0 + rdg_shear(i,j,iblk) = c0 + divu (i,j,iblk) = c0 + shear(i,j,iblk) = c0 + enddo + enddo + + !----------------------------------------------------------------- + ! preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep1 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + aice (:,:,iblk), vice (:,:,iblk), & + vsno (:,:,iblk), tmask (:,:,iblk), & + strairxT(:,:,iblk), strairyT(:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + tmass (:,:,iblk), icetmask(:,:,iblk)) + + enddo ! iblk + !$OMP END PARALLEL DO + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (icetmask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + + !----------------------------------------------------------------- + ! convert fields from T to U grid + !----------------------------------------------------------------- + + call to_ugrid(tmass,umass) + call to_ugrid(aice_init, aiu) + + !---------------------------------------------------------------- + ! Set wind stress to values supplied via NEMO or other forcing + ! This wind stress is rotated on u grid and multiplied by aice + !---------------------------------------------------------------- + call icepack_query_parameters(calc_strair_out=calc_strair) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + if (.not. calc_strair) then + strairx(:,:,:) = strax(:,:,:) + strairy(:,:,:) = stray(:,:,:) + else + call t2ugrid_vector(strairx) + call t2ugrid_vector(strairy) + endif + +! tcraig, tcx, threading here leads to some non-reproducbile results and failures in icepack_ice_strength +! need to do more debugging + !$TCXOMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) + do iblk = 1, nblocks + + !----------------------------------------------------------------- + ! more preparation for dynamics + !----------------------------------------------------------------- + + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call dyn_prep2 (nx_block, ny_block, & + ilo, ihi, jlo, jhi, & + icellt(iblk), icellu(iblk), & + indxti (:,iblk), indxtj (:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), umass (:,:,iblk), & + umassdti (:,:,iblk), fcor_blk (:,:,iblk), & + umask (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + ss_tltx (:,:,iblk), ss_tlty (:,:,iblk), & + icetmask (:,:,iblk), iceumask (:,:,iblk), & + fm (:,:,iblk), dt, & + strtltx (:,:,iblk), strtlty (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,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), & + uvel_init (:,:,iblk), vvel_init (:,:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + Tbu (:,:,iblk)) + + call calc_bfix (nx_block , ny_block , & + icellu(iblk) , & + indxui (:,iblk), indxuj (:,iblk), & + umassdti (:,:,iblk), & + forcex (:,:,iblk), forcey (:,:,iblk), & + uvel_init (:,:,iblk), vvel_init (:,:,iblk), & + bxfix (:,:,iblk), byfix (:,:,iblk)) + + !----------------------------------------------------------------- + ! ice strength + !----------------------------------------------------------------- + + strength(:,:,iblk) = c0 ! initialize + do ij = 1, icellt(iblk) + i = indxti(ij, iblk) + j = indxtj(ij, iblk) + call icepack_ice_strength (ncat, & + aice (i,j, iblk), & + vice (i,j, iblk), & + aice0 (i,j, iblk), & + aicen (i,j,:,iblk), & + vicen (i,j,:,iblk), & + strength(i,j, iblk)) + enddo ! ij + + enddo ! iblk + !$TCXOMP END PARALLEL DO + + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + call ice_timer_start(timer_bound) + call ice_HaloUpdate (strength, halo_info, & + field_loc_center, field_type_scalar) + ! velocities may have changed in dyn_prep2 + call stack_velocity_field(uvel, vvel, fld2) + call ice_HaloUpdate (fld2, halo_info, & + field_loc_NEcorner, field_type_vector) + call unstack_velocity_field(fld2, uvel, vvel) + call ice_timer_stop(timer_bound) + + if (maskhalo_dyn) then + call ice_timer_start(timer_bound) + halomask = 0 + where (iceumask) halomask = 1 + call ice_HaloUpdate (halomask, halo_info, & + field_loc_center, field_type_scalar) + call ice_timer_stop(timer_bound) + call ice_HaloMask(halo_info_mask, halo_info, halomask) + endif + + !----------------------------------------------------------------- + ! basal stress coefficients (landfast ice) + !----------------------------------------------------------------- + + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call basal_stress_coeff (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:,iblk), & + vice (:,:,iblk), aice(:,:,iblk), & + hwater(:,:,iblk), Tbu (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + !----------------------------------------------------------------- + ! calc size of problem (ntot) and allocate solution vector + !----------------------------------------------------------------- + + ntot = 0 + do iblk = 1, nblocks + ntot = ntot + icellu(iblk) + enddo + ntot = 2 * ntot ! times 2 because of u and v + + allocate(sol(ntot)) + + !----------------------------------------------------------------- + ! Start of nonlinear iteration + !----------------------------------------------------------------- + call anderson_solver (icellt , icellu, & + indxti , indxtj, & + indxui , indxuj, & + aiu , ntot , & + waterx , watery, & + bxfix , byfix , & + umassdti, sol , & + fpresx , fpresy, & + zetaD , Cb , & + halo_info_mask) + !----------------------------------------------------------------- + ! End of nonlinear iteration + !----------------------------------------------------------------- + + deallocate(sol) + + if (maskhalo_dyn) call ice_HaloDestroy(halo_info_mask) + + !----------------------------------------------------------------- + ! Compute stresses + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call stress_vp (nx_block , ny_block , & + icellt(iblk) , & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + zetaD (:,:,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)) + enddo ! iblk + !$OMP END PARALLEL DO + + !----------------------------------------------------------------- + ! Compute deformations + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call deformations (nx_block , ny_block , & + icellt(iblk) , & + indxti (:,iblk), indxtj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tarear (:,:,iblk), & + shear (:,:,iblk), divu (:,:,iblk), & + rdg_conv (:,:,iblk), rdg_shear (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + + !----------------------------------------------------------------- + ! Compute seabed stress (diagnostic) + !----------------------------------------------------------------- + if (basalstress) then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_seabed_stress (nx_block , ny_block , & + icellu(iblk) , & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + Cb (:,:,iblk), & + taubx (:,:,iblk), tauby (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + ! Force symmetry across the tripole seam + if (trim(grid_type) == 'tripole') then + if (maskhalo_dyn) then + !------------------------------------------------------- + ! set halomask to zero because ice_HaloMask always keeps + ! local copies AND tripole zipper communication + !------------------------------------------------------- + halomask = 0 + call ice_HaloMask(halo_info_mask, halo_info, halomask) + + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info_mask, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info_mask, & + field_loc_center, field_type_scalar) + + call ice_HaloDestroy(halo_info_mask) + else + call ice_HaloUpdate_stress(stressp_1, stressp_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_3, stressp_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_2, stressp_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressp_4, stressp_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stressm_1, stressm_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_3, stressm_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_2, stressm_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stressm_4, stressm_2, halo_info, & + field_loc_center, field_type_scalar) + + call ice_HaloUpdate_stress(stress12_1, stress12_3, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_3, stress12_1, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_2, stress12_4, halo_info, & + field_loc_center, field_type_scalar) + call ice_HaloUpdate_stress(stress12_4, stress12_2, halo_info, & + field_loc_center, field_type_scalar) + endif ! maskhalo + endif ! tripole + + !----------------------------------------------------------------- + ! ice-ocean stress + !----------------------------------------------------------------- + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + call dyn_finish & + (nx_block, ny_block, & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + uvel (:,:,iblk), vvel (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + aiu (:,:,iblk), fm (:,:,iblk), & + strintx (:,:,iblk), strinty (:,:,iblk), & + strairx (:,:,iblk), strairy (:,:,iblk), & + strocnx (:,:,iblk), strocny (:,:,iblk), & + strocnxT(:,:,iblk), strocnyT(:,:,iblk)) + + enddo + !$OMP END PARALLEL DO + + call u2tgrid_vector(strocnxT) ! shift + call u2tgrid_vector(strocnyT) + + call ice_timer_stop(timer_dynamics) ! dynamics + + end subroutine implicit_solver + +!======================================================================= + +! Solve the nonlinear equation F(u,v) = 0, where +! F(u,v) := A(u,v) * (u,v) - b(u,v) +! using Anderson acceleration (accelerated fixed point (Picard) iteration) +! +! author: JF Lemieux, A. Qaddouri, F. Dupont and P. Blain ECCC +! +! Anderson algorithm adadpted from: +! H. F. Walker, “Anderson Acceleration: Algorithms and Implementations” +! [Online]. Available: https://users.wpi.edu/~walker/Papers/anderson_accn_algs_imps.pdf + + subroutine anderson_solver (icellt , icellu, & + indxti , indxtj, & + indxui , indxuj, & + aiu , ntot , & + waterx , watery, & + bxfix , byfix , & + umassdti, sol , & + fpresx , fpresy, & + zetaD , Cb , & + halo_info_mask) + + use ice_arrays_column, only: Cdn_ocn + use ice_blocks, only: nx_block, ny_block + use ice_boundary, only: ice_HaloUpdate + use ice_constants, only: c1 + use ice_domain, only: maskhalo_dyn, halo_info + use ice_domain_size, only: max_blocks + use ice_flux, only: uocn, vocn, fm, Tbu + use ice_grid, only: dxt, dyt, dxhy, dyhx, cxp, cyp, cxm, cym, & + uarear, tinyarea + use ice_state, only: uvel, vvel, strength + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + + integer (kind=int_kind), intent(in) :: & + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension(max_blocks), intent(in) :: & + icellt , & ! no. of cells where icetmask = 1 + icellu ! no. of cells where iceumask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj , & ! compressed index in j-direction + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + aiu , & ! ice fraction on u-grid + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + bxfix , & ! part of bx that is constant during Picard + byfix , & ! part of by that is constant during Picard + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(out) :: & + zetaD ! zetaD = 2zeta (viscous coeff) + + type (ice_halo), intent(in) :: & + halo_info_mask ! ghost cell update info for masked halo + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(inout) :: & + fpresx , & ! fixed point residual vector, x components: fx = uvel - uprev_k + fpresy , & ! fixed point residual vector, y components: fy = vvel - vprev_k + Cb ! seabed stress coefficient + + real (kind=dbl_kind), dimension (ntot), intent(inout) :: & + sol ! current approximate solution + + ! local variables + + integer (kind=int_kind) :: & + it_nl , & ! nonlinear loop iteration index + res_num , & ! current number of stored residuals + j , & ! iteration index for QR update + iblk , & ! block index + nbiter ! number of FGMRES iterations performed + + integer (kind=int_kind), parameter :: & + inc = 1 ! increment value for BLAS calls + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + uprev_k , & ! uvel at previous Picard iteration + vprev_k , & ! vvel at previous Picard iteration + ulin , & ! uvel to linearize vrel + vlin , & ! vvel to linearize vrel + vrel , & ! coeff for tauw + bx , & ! b vector + by , & ! b vector + diagx , & ! Diagonal (x component) of the matrix A + diagy , & ! Diagonal (y component) of the matrix A + Au , & ! matvec, Fx = bx - Au + Av , & ! matvec, Fy = by - Av + Fx , & ! x residual vector, Fx = bx - Au + Fy , & ! y residual vector, Fy = by - Av + solx , & ! solution of FGMRES (x components) + soly ! solution of FGMRES (y components) + + real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & + stress_Pr, & ! x,y-derivatives of the replacement pressure + diag_rheo ! contributions of the rhelogy term to the diagonal + + real (kind=dbl_kind), dimension (max_blocks) :: & + L2norm ! array used to compute l^2 norm of grid function + + real (kind=dbl_kind), dimension (ntot) :: & + res , & ! current residual + res_old , & ! previous residual + res_diff , & ! difference between current and previous residuals + fpfunc , & ! current value of fixed point function + fpfunc_old , & ! previous value of fixed point function + tmp ! temporary vector for BLAS calls + + real (kind=dbl_kind), dimension(ntot,dim_andacc) :: & + Q , & ! Q factor for QR factorization of F (residuals) matrix + G_diff ! Matrix containing the differences of g(x) (fixed point function) evaluations + + real (kind=dbl_kind), dimension(dim_andacc,dim_andacc) :: & + R ! R factor for QR factorization of F (residuals) matrix + + real (kind=dbl_kind), dimension(dim_andacc) :: & + rhs_tri , & ! right hand side vector for matrix-vector product + coeffs ! coeffs used to combine previous solutions + + real (kind=dbl_kind) :: & + ! tol , & ! tolerance for fixed point convergence: reltol_andacc * (initial fixed point residual norm) [unused for now] + tol_nl , & ! tolerance for nonlinear convergence: reltol_nonlin * (initial nonlinear residual norm) + fpres_norm , & ! norm of current fixed point residual : f(x) = g(x) - x + prog_norm , & ! norm of difference between current and previous solution + nlres_norm ! norm of current nonlinear residual : F(x) = A(x)x -b(x) + +#ifdef USE_LAPACK + real (kind=dbl_kind) :: & + ddot, dnrm2 ! external BLAS functions +#endif + + character(len=*), parameter :: subname = '(anderson_solver)' + + ! Initialization + res_num = 0 + L2norm = c0 + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + uprev_k(:,:,iblk) = uvel(:,:,iblk) + vprev_k(:,:,iblk) = vvel(:,:,iblk) + enddo + !$OMP END PARALLEL DO + + ! Start iterations + do it_nl = 0, maxits_nonlin ! nonlinear iteration loop + ! Compute quantities needed for computing PDE residual and g(x) (fixed point map) + !----------------------------------------------------------------- + ! Calc zetaD, dPr/dx, dPr/dy, Cb and vrel = f(uprev_k, vprev_k) + !----------------------------------------------------------------- + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + + if (use_mean_vrel) then + ulin(:,:,iblk) = p5*uprev_k(:,:,iblk) + p5*uvel(:,:,iblk) + vlin(:,:,iblk) = p5*vprev_k(:,:,iblk) + p5*vvel(:,:,iblk) + else + ulin(:,:,iblk) = uvel(:,:,iblk) + vlin(:,:,iblk) = vvel(:,:,iblk) + endif + uprev_k(:,:,iblk) = uvel(:,:,iblk) + vprev_k(:,:,iblk) = vvel(:,:,iblk) + + call calc_zeta_dPr (nx_block , ny_block , & + icellt (iblk), & + indxti (:,iblk), indxtj (:,iblk), & + uprev_k (:,:,iblk), vprev_k (:,:,iblk), & + dxt (:,:,iblk), dyt (:,:,iblk), & + dxhy (:,:,iblk), dyhx (:,:,iblk), & + cxp (:,:,iblk), cyp (:,:,iblk), & + cxm (:,:,iblk), cym (:,:,iblk), & + tinyarea (:,:,iblk), & + strength (:,:,iblk), zetaD (:,:,iblk,:), & + stress_Pr (:,:,:)) + + call calc_vrel_Cb (nx_block , ny_block , & + icellu (iblk), Cdn_ocn (:,:,iblk), & + indxui (:,iblk), indxuj (:,iblk), & + aiu (:,:,iblk), Tbu (:,:,iblk), & + uocn (:,:,iblk), vocn (:,:,iblk), & + ulin (:,:,iblk), vlin (:,:,iblk), & + vrel (:,:,iblk), Cb (:,:,iblk)) + + ! prepare b vector (RHS) + call calc_bvec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + stress_Pr (:,:,:), uarear (:,:,iblk), & + waterx (:,:,iblk), watery (:,:,iblk), & + bxfix (:,:,iblk), byfix (:,:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + vrel (:,:,iblk)) + + ! Compute nonlinear residual norm (PDE residual) + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + uprev_k (:,:,iblk) , vprev_k (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + Au (:,:,iblk) , Av (:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + Au (:,:,iblk), Av (:,:,iblk), & + Fx (:,:,iblk), Fy (:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + nlres_norm = sqrt(global_sum(sum(L2norm), distrb_info)) + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " nonlin_res_L2norm= ", nlres_norm + endif + ! Compute relative tolerance at first iteration + if (it_nl == 0) then + tol_nl = reltol_nonlin*nlres_norm + endif + + ! Check for nonlinear convergence + if (nlres_norm < tol_nl) then + exit + endif + + ! Put initial guess for FGMRES in solx,soly and sol (needed for anderson) + solx = uprev_k + soly = vprev_k + call arrays_to_vec (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + uprev_k (:,:,:), vprev_k (:,:,:), & + sol (:)) + + ! Compute fixed point map g(x) + if (fpfunc_andacc == 1) then + ! g_1(x) = FGMRES(A(x), b(x)) + + ! Prepare diagonal for preconditioner + if (precond == 'diag' .or. precond == 'pgmres') then + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + ! first compute diagonal contributions due to rheology term + call formDiag_step1 (nx_block , ny_block , & + icellu (iblk) , & + indxui (:,iblk) , indxuj(:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx(:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + zetaD (:,:,iblk,:), diag_rheo(:,:,:)) + ! second compute the full diagonal + call formDiag_step2 (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + diag_rheo (:,:,:), vrel (:,:,iblk), & + umassdti (:,:,iblk), & + uarear (:,:,iblk), Cb (:,:,iblk), & + diagx (:,:,iblk), diagy (:,:,iblk)) + enddo + !$OMP END PARALLEL DO + endif + + ! FGMRES linear solver + call fgmres (zetaD , & + Cb , vrel , & + umassdti , & + halo_info_mask, & + bx , by , & + diagx , diagy , & + reltol_fgmres , dim_fgmres, & + maxits_fgmres , & + solx , soly , & + nbiter) + ! Put FGMRES solution solx,soly in fpfunc vector (needed for Anderson) + call arrays_to_vec (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + solx (:,:,:), soly (:,:,:), & + fpfunc (:)) + elseif (fpfunc_andacc == 2) then + ! g_2(x) = x - A(x)x + b(x) = x - F(x) + call abort_ice(error_message=subname // " Fixed point function g_2(x) not yet implemented (fpfunc_andacc = 2)" , & + file=__FILE__, line=__LINE__) + endif + + ! Compute fixed point residual f(x) = g(x) - x + res = fpfunc - sol +#ifdef USE_LAPACK + fpres_norm = global_sum(dnrm2(size(res), res, inc)**2, distrb_info) +#else + call vec_to_arrays (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj(:,:) , & + res (:), & + fpresx (:,:,:), fpresy (:,:,:)) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + fpresx(:,:,iblk), fpresy(:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + fpres_norm = sqrt(global_sum(sum(L2norm), distrb_info)) +#endif + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " fixed_point_res_L2norm= ", fpres_norm + endif + + ! Not used for now (only nonlinear residual is checked) + ! ! Store initial residual norm + ! if (it_nl == 0) then + ! tol = reltol_andacc*fpres_norm + ! endif + ! + ! ! Check residual + ! if (fpres_norm < tol) then + ! exit + ! endif + + if (dim_andacc == 0 .or. it_nl < start_andacc) then + ! Simple fixed point (Picard) iteration in this case + sol = fpfunc + else +#ifdef USE_LAPACK + ! Begin Anderson acceleration + if (get_num_procs() > 1) then + ! Anderson solver is not yet parallelized; abort + if (my_task == master_task) then + call abort_ice(error_message=subname // " Anderson solver (algo_nonlin = 'anderson') is not yet parallelized, and nprocs > 1 " , & + file=__FILE__, line=__LINE__) + endif + endif + if (it_nl > start_andacc) then + ! Update residual difference vector + res_diff = res - res_old + ! Update fixed point function difference matrix + if (res_num < dim_andacc) then + ! Add column + G_diff(:,res_num+1) = fpfunc - fpfunc_old + else + ! Delete first column and add column + G_diff(:,1:res_num-1) = G_diff(:,2:res_num) + G_diff(:,res_num) = fpfunc - fpfunc_old + endif + res_num = res_num + 1 + endif + res_old = res + fpfunc_old = fpfunc + if (res_num == 0) then + sol = fpfunc + else + if (res_num == 1) then + ! Initialize QR factorization + R(1,1) = dnrm2(size(res_diff), res_diff, inc) + Q(:,1) = res_diff/R(1,1) + else + if (res_num > dim_andacc) then + ! Update factorization since 1st column was deleted + call qr_delete(Q,R) + res_num = res_num - 1 + endif + ! Update QR factorization for new column + do j = 1, res_num - 1 + R(j,res_num) = ddot(ntot, Q(:,j), inc, res_diff, inc) + res_diff = res_diff - R(j,res_num) * Q(:,j) + enddo + R(res_num, res_num) = dnrm2(size(res_diff) ,res_diff, inc) + Q(:,res_num) = res_diff / R(res_num, res_num) + endif + ! TODO: here, drop more columns to improve conditioning + ! if (droptol) then + + ! endif + ! Solve least square problem for coefficients + ! 1. Compute rhs_tri = Q^T * res + call dgemv ('t', size(Q,1), res_num, c1, Q(:,1:res_num), size(Q,1), res, inc, c0, rhs_tri, inc) + ! 2. Solve R*coeffs = rhs_tri, put result in rhs_tri + call dtrsv ('u', 'n', 'n', res_num, R(1:res_num,1:res_num), res_num, rhs_tri, inc) + coeffs = rhs_tri + ! Update approximate solution: x = fpfunc - G_diff*coeffs, put result in fpfunc + call dgemv ('n', size(G_diff,1), res_num, -c1, G_diff(:,1:res_num), size(G_diff,1), coeffs, inc, c1, fpfunc, inc) + sol = fpfunc + ! Apply damping + if (damping_andacc > 0 .and. damping_andacc /= 1) then + ! x = x - (1-beta) (res - Q*R*coeffs) + + ! tmp = R*coeffs + call dgemv ('n', res_num, res_num, c1, R(1:res_num,1:res_num), res_num, coeffs, inc, c0, tmp, inc) + ! res = res - Q*tmp + call dgemv ('n', size(Q,1), res_num, -c1, Q(:,1:res_num), size(Q,1), tmp, inc, c1, res, inc) + ! x = x - (1-beta)*res + sol = sol - (1-damping_andacc)*res + endif + endif +#else + ! Anderson solver is not usable without LAPACK; abort + call abort_ice(error_message=subname // " CICE was not compiled with LAPACK, and Anderson solver was chosen (algo_nonlin = 'anderson')" , & + file=__FILE__, line=__LINE__) +#endif + endif + + !----------------------------------------------------------------------- + ! Put vector sol in uvel and vvel arrays + !----------------------------------------------------------------------- + call vec_to_arrays (nx_block , ny_block , & + nblocks , max_blocks , & + icellu (:), ntot , & + indxui (:,:), indxuj (:,:), & + sol (:), & + uvel (:,:,:), vvel (:,:,:)) + + ! Do halo update so that halo cells contain up to date info for advection + 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) + + ! Compute "progress" residual norm + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + fpresx(:,:,iblk) = uvel(:,:,iblk) - uprev_k(:,:,iblk) + fpresy(:,:,iblk) = vvel(:,:,iblk) - vprev_k(:,:,iblk) + call calc_L2norm_squared (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + fpresx(:,:,iblk), fpresy(:,:,iblk), & + L2norm (iblk)) + enddo + !$OMP END PARALLEL DO + prog_norm = sqrt(global_sum(sum(L2norm), distrb_info)) + if (my_task == master_task .and. monitor_nonlin) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_nonlin: iter_nonlin= ", it_nl, & + " progress_res_L2norm= ", prog_norm + endif + + enddo ! nonlinear iteration loop + + end subroutine anderson_solver + +!======================================================================= + +! Computes the viscous coefficients (in fact zetaD=2*zeta) and dPr/dx, dPr/dy + + subroutine calc_zeta_dPr (nx_block, ny_block, & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + tinyarea, & + strength, zetaD , & + stPr) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + strength , & ! ice strength (N/m) + uvel , & ! x-component of velocity (m/s) + 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 + tinyarea ! min_strain_rate*tarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(out) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(out) :: & + stPr ! stress combinations from replacement pressure + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw , & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt + ssigpn, ssigps, ssigpe, ssigpw, ssigp1, ssigp2, & + csigpne, csigpnw, csigpsw, csigpse , & + stressp_1, stressp_2, stressp_3, stressp_4 , & + strp_tmp + + logical :: capping ! of the viscous coeff + + character(len=*), parameter :: subname = '(calc_zeta_dPr)' + + ! Initialize + + capping = .false. + + ! Initialize stPr and zetaD to zero (for cells where icetmask is false) + stPr = c0 + zetaD = c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + if (capping) then + zetaD(i,j,1) = strength(i,j)/max(Deltane,tinyarea(i,j)) + zetaD(i,j,2) = strength(i,j)/max(Deltanw,tinyarea(i,j)) + zetaD(i,j,3) = strength(i,j)/max(Deltasw,tinyarea(i,j)) + zetaD(i,j,4) = strength(i,j)/max(Deltase,tinyarea(i,j)) + else + zetaD(i,j,1) = strength(i,j)/(Deltane + tinyarea(i,j)) + zetaD(i,j,2) = strength(i,j)/(Deltanw + tinyarea(i,j)) + zetaD(i,j,3) = strength(i,j)/(Deltasw + tinyarea(i,j)) + zetaD(i,j,4) = strength(i,j)/(Deltase + tinyarea(i,j)) + endif + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1 = -zetaD(i,j,1)*(Deltane*(c1-Ktens)) + stressp_2 = -zetaD(i,j,2)*(Deltanw*(c1-Ktens)) + stressp_3 = -zetaD(i,j,3)*(Deltasw*(c1-Ktens)) + stressp_4 = -zetaD(i,j,4)*(Deltase*(c1-Ktens)) + + !----------------------------------------------------------------- + ! combinations of the Pr related stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + + ! northeast (i,j) + stPr(i,j,1) = -strp_tmp & + + dxhy(i,j)*(-csigpne) + + ! northwest (i+1,j) + stPr(i,j,2) = strp_tmp & + + dxhy(i,j)*(-csigpnw) + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + + ! southeast (i,j+1) + stPr(i,j,3) = -strp_tmp & + + dxhy(i,j)*(-csigpse) + + ! southwest (i+1,j+1) + stPr(i,j,4) = strp_tmp & + + dxhy(i,j)*(-csigpsw) + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + + ! northeast (i,j) + stPr(i,j,5) = -strp_tmp & + - dyhx(i,j)*(csigpne) + + ! southeast (i,j+1) + stPr(i,j,6) = strp_tmp & + - dyhx(i,j)*(csigpse) + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + + ! northwest (i+1,j) + stPr(i,j,7) = -strp_tmp & + - dyhx(i,j)*(csigpnw) + + ! southwest (i+1,j+1) + stPr(i,j,8) = strp_tmp & + - dyhx(i,j)*(csigpsw) + + enddo ! ij + + end subroutine calc_zeta_dPr + +!======================================================================= + +! Computes the VP stresses (as diagnostic) + + subroutine stress_vp (nx_block , ny_block , & + icellt , & + indxti , indxtj , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + zetaD , & + stressp_1 , stressp_2 , & + stressp_3 , stressp_4 , & + stressm_1 , stressm_2 , & + stressm_3 , stressm_4 , & + stress12_1, stress12_2, & + stress12_3, stress12_4) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + 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 + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw ! Delt + + character(len=*), parameter :: subname = '(stress_vp)' + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1(i,j) = zetaD(i,j,1)*(divune*(c1+Ktens) - Deltane*(c1-Ktens)) + stressp_2(i,j) = zetaD(i,j,2)*(divunw*(c1+Ktens) - Deltanw*(c1-Ktens)) + stressp_3(i,j) = zetaD(i,j,3)*(divusw*(c1+Ktens) - Deltasw*(c1-Ktens)) + stressp_4(i,j) = zetaD(i,j,4)*(divuse*(c1+Ktens) - Deltase*(c1-Ktens)) + + stressm_1(i,j) = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2(i,j) = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3(i,j) = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4(i,j) = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1(i,j) = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2(i,j) = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3(i,j) = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4(i,j) = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + enddo ! ij + + end subroutine stress_vp + +!======================================================================= + +! Compute vrel and seabed stress coefficients + + subroutine calc_vrel_Cb (nx_block, ny_block, & + icellu , Cw , & + indxui , indxuj , & + aiu , Tbu , & + uocn , vocn , & + uvel , vvel , & + vrel , Cb) + + use ice_dyn_shared, only: u0 ! residual velocity for basal stress (m/s) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + Tbu, & ! coefficient for basal stress (N/m^2) + aiu , & ! ice fraction on u-grid + uocn , & ! ocean current, x-direction (m/s) + vocn , & ! ocean current, y-direction (m/s) + Cw ! ocean-ice neutral drag coefficient + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel ! y-component of velocity (m/s) + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + vrel , & ! coeff for tauw + Cb ! seabed stress coeff + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + rhow ! + + character(len=*), parameter :: subname = '(calc_vrel_Cb)' + + 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__) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ! (magnitude of relative ocean current)*rhow*drag*aice + vrel(i,j) = aiu(i,j)*rhow*Cw(i,j)*sqrt((uocn(i,j) - uvel(i,j))**2 + & + (vocn(i,j) - vvel(i,j))**2) ! m/s + + Cb(i,j) = Tbu(i,j) / (sqrt(uvel(i,j)**2 + vvel(i,j)**2) + u0) ! for seabed stress + enddo ! ij + + end subroutine calc_vrel_Cb + +!======================================================================= + +! Compute seabed stress (diagnostic) + + subroutine calc_seabed_stress (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + uvel , vvel , & + Cb , & + taubx , tauby) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + Cb ! seabed stress coefficient + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + taubx , & ! seabed stress, x-direction (N/m^2) + tauby ! seabed stress, y-direction (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_seabed_stress)' + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + taubx(i,j) = -uvel(i,j)*Cb(i,j) + tauby(i,j) = -vvel(i,j)*Cb(i,j) + enddo ! ij + + end subroutine calc_seabed_stress + +!======================================================================= + +! Computes the matrix vector product A(u,v) * (u,v) +! Au = A(u,v)_[x] * uvel (x components of A(u,v) * (u,v)) +! Av = A(u,v)_[y] * vvel (y components of A(u,v) * (u,v)) + + subroutine matvec (nx_block, ny_block, & + icellu , icellt , & + indxui , indxuj , & + indxti , indxtj , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + uvel , vvel , & + vrel , Cb , & + zetaD , & + umassdti, fm , & + uarear , & + Au , Av) + + use ice_dyn_shared, only: strain_rates + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu, & ! total count when iceumask is true + icellt ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj , & ! compressed index in j-direction + indxti , & ! compressed index in i-direction + indxtj ! compressed index in j-direction + + 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 + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel , & ! x-component of velocity (m/s) + vvel , & ! y-component of velocity (m/s) + vrel , & ! coefficient for tauw + Cb , & ! coefficient for basal stress + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + fm , & ! Coriolis param. * mass in U-cell (kg/s) + uarear ! 1/uarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + Au , & ! matvec, Fx = bx - Au (N/m^2) + Av ! matvec, Fy = by - Av (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind), dimension(nx_block,ny_block,8):: & + str + + real (kind=dbl_kind) :: & + ccaimp,ccb , & ! intermediate variables + strintx, strinty ! divergence of the internal stress tensor + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + Deltane, Deltanw, Deltase, Deltasw , & ! Delt + 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 + + real (kind=dbl_kind) :: & + stressp_1, stressp_2, stressp_3, stressp_4 , & ! sigma11+sigma22 (without Pr) + stressm_1, stressm_2, stressm_3, stressm_4 , & ! sigma11-sigma22 + stress12_1,stress12_2,stress12_3,stress12_4 ! sigma12 + + character(len=*), parameter :: subname = '(matvec)' + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + str(:,:,:) = c0 + + do ij = 1, icellt + i = indxti(ij) + j = indxtj(ij) + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + call strain_rates (nx_block , ny_block , & + i , j , & + uvel , vvel , & + dxt , dyt , & + cxp , cyp , & + cxm , cym , & + divune , divunw , & + divuse , divusw , & + tensionne, tensionnw, & + tensionse, tensionsw, & + shearne , shearnw , & + shearse , shearsw , & + Deltane , Deltanw , & + Deltase , Deltasw) + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + ! NOTE: commented part of stressp is from the replacement pressure Pr + !----------------------------------------------------------------- + + stressp_1 = zetaD(i,j,1)*(divune*(c1+Ktens))! - Deltane*(c1-Ktens)) + stressp_2 = zetaD(i,j,2)*(divunw*(c1+Ktens))! - Deltanw*(c1-Ktens)) + stressp_3 = zetaD(i,j,3)*(divusw*(c1+Ktens))! - Deltasw*(c1-Ktens)) + stressp_4 = zetaD(i,j,4)*(divuse*(c1+Ktens))! - Deltase*(c1-Ktens)) + + stressm_1 = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2 = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3 = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4 = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1 = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2 = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3 = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4 = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + ssigmn = stressm_1 + stressm_2 + ssigms = stressm_3 + stressm_4 + ssigme = stressm_1 + stressm_4 + ssigmw = stressm_2 + stressm_3 + ssigm1 =(stressm_1 + stressm_3)*p055 + ssigm2 =(stressm_2 + stressm_4)*p055 + + ssig12n = stress12_1 + stress12_2 + ssig12s = stress12_3 + stress12_4 + ssig12e = stress12_1 + stress12_4 + ssig12w = stress12_2 + stress12_3 + ssig121 =(stress12_1 + stress12_3)*p111 + ssig122 =(stress12_2 + stress12_4)*p111 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + csigmne = p111*stressm_1 + ssigm2 + p027*stressm_3 + csigmnw = p111*stressm_2 + ssigm1 + p027*stressm_4 + csigmsw = p111*stressm_3 + ssigm2 + p027*stressm_1 + csigmse = p111*stressm_4 + ssigm1 + p027*stressm_2 + + csig12ne = p222*stress12_1 + ssig122 & + + p055*stress12_3 + csig12nw = p222*stress12_2 + ssig121 & + + p055*stress12_4 + csig12sw = p222*stress12_3 + ssig122 & + + p055*stress12_1 + csig12se = p222*stress12_4 + ssig121 & + + p055*stress12_2 + + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + str(i,j,1) = -strp_tmp - strm_tmp - str12ew & + + dxhy(i,j)*(-csigpne + csigmne) + dyhx(i,j)*csig12ne + + ! northwest (i+1,j) + str(i,j,2) = strp_tmp + strm_tmp - str12we & + + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + str(i,j,3) = -strp_tmp - strm_tmp + str12ew & + + dxhy(i,j)*(-csigpse + csigmse) + dyhx(i,j)*csig12se + + ! southwest (i+1,j+1) + str(i,j,4) = strp_tmp + strm_tmp + str12we & + + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + str(i,j,5) = -strp_tmp + strm_tmp - str12ns & + - dyhx(i,j)*(csigpne + csigmne) + dxhy(i,j)*csig12ne + + ! southeast (i,j+1) + str(i,j,6) = strp_tmp - strm_tmp - str12sn & + - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + str(i,j,7) = -strp_tmp + strm_tmp + str12ns & + - dyhx(i,j)*(csigpnw + csigmnw) + dxhy(i,j)*csig12nw + + ! southwest (i+1,j+1) + str(i,j,8) = strp_tmp - strm_tmp + str12sn & + - dyhx(i,j)*(csigpsw + csigmsw) + dxhy(i,j)*csig12sw + + enddo ! ij - icellt + + !----------------------------------------------------------------- + ! Form Au and Av + !----------------------------------------------------------------- + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ccaimp = umassdti(i,j) + vrel(i,j) * cosw + Cb(i,j) ! kg/m^2 s + + ccb = fm(i,j) + sign(c1,fm(i,j)) * vrel(i,j) * sinw ! kg/m^2 s + + ! divergence of the internal stress tensor + strintx = uarear(i,j)* & + (str(i,j,1) + str(i+1,j,2) + str(i,j+1,3) + str(i+1,j+1,4)) + strinty = uarear(i,j)* & + (str(i,j,5) + str(i,j+1,6) + str(i+1,j,7) + str(i+1,j+1,8)) + + Au(i,j) = ccaimp*uvel(i,j) - ccb*vvel(i,j) - strintx + Av(i,j) = ccaimp*vvel(i,j) + ccb*uvel(i,j) - strinty + enddo ! ij - icellu + + end subroutine matvec + +!======================================================================= + +! Compute the constant component of b(u,v) i.e. the part of b(u,v) that +! does not depend on (u,v) and thus do not change during the nonlinear iteration + + subroutine calc_bfix (nx_block , ny_block , & + icellu , & + indxui , indxuj , & + umassdti , & + forcex , forcey , & + uvel_init, vvel_init, & + bxfix , byfix) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! no. of cells where iceumask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uvel_init,& ! x-component of velocity (m/s), beginning of time step + vvel_init,& ! y-component of velocity (m/s), beginning of time step + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + forcex , & ! work array: combined atm stress and ocn tilt, x + forcey ! work array: combined atm stress and ocn tilt, y + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + bxfix , & ! bx = taux + bxfix + byfix ! by = tauy + byfix + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_bfix)' + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + bxfix(i,j) = umassdti(i,j)*uvel_init(i,j) + forcex(i,j) + byfix(i,j) = umassdti(i,j)*vvel_init(i,j) + forcey(i,j) + enddo + + end subroutine calc_bfix + +!======================================================================= + +! Compute the vector b(u,v), i.e. the part of the nonlinear function F(u,v) +! that cannot be written as A(u,v)*(u,v), where A(u,v) is a matrix with entries +! depending on (u,v) + + subroutine calc_bvec (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + stPr , uarear , & + waterx , watery , & + bxfix , byfix , & + bx , by , & + vrel) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + uarear , & ! 1/uarea + waterx , & ! for ocean stress calculation, x (m/s) + watery , & ! for ocean stress calculation, y (m/s) + bxfix , & ! bx = taux + bxfix + byfix , & ! by = tauy + byfix + vrel ! relative ice-ocean velocity + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(in) :: & + stPr + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + bx , & ! b vector, bx = taux + bxfix (N/m^2) + by ! b vector, by = tauy + byfix (N/m^2) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + taux, tauy , & ! part of ocean stress term + strintx, strinty , & ! divergence of the internal stress tensor (only Pr contributions) + rhow ! + + character(len=*), parameter :: subname = '(calc_bvec)' + + !----------------------------------------------------------------- + ! calc b vector + !----------------------------------------------------------------- + + 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__) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ! ice/ocean stress + taux = vrel(i,j)*waterx(i,j) ! NOTE this is not the entire + tauy = vrel(i,j)*watery(i,j) ! ocn stress term + + ! divergence of the internal stress tensor (only Pr part, i.e. dPr/dx, dPr/dy) + strintx = uarear(i,j)* & + (stPr(i,j,1) + stPr(i+1,j,2) + stPr(i,j+1,3) + stPr(i+1,j+1,4)) + strinty = uarear(i,j)* & + (stPr(i,j,5) + stPr(i,j+1,6) + stPr(i+1,j,7) + stPr(i+1,j+1,8)) + + bx(i,j) = bxfix(i,j) + taux + strintx + by(i,j) = byfix(i,j) + tauy + strinty + enddo ! ij + + end subroutine calc_bvec + +!======================================================================= + +! Compute the non linear residual F(u,v) = b(u,v) - A(u,v) * (u,v), +! with Au, Av precomputed as +! Au = A(u,v)_[x] * uvel (x components of A(u,v) * (u,v)) +! Av = A(u,v)_[y] * vvel (y components of A(u,v) * (u,v)) + + subroutine residual_vec (nx_block , ny_block, & + icellu , & + indxui , indxuj , & + bx , by , & + Au , Av , & + Fx , Fy , & + sum_squared) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + bx , & ! b vector, bx = taux + bxfix (N/m^2) + by , & ! b vector, by = tauy + byfix (N/m^2) + Au , & ! matvec, Fx = bx - Au (N/m^2) + Av ! matvec, Fy = by - Av (N/m^2) + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(inout) :: & + Fx , & ! x residual vector, Fx = bx - Au (N/m^2) + Fy ! y residual vector, Fy = by - Av (N/m^2) + + real (kind=dbl_kind), intent(out), optional :: & + sum_squared ! sum of squared residual vector components + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(residual_vec)' + + !----------------------------------------------------------------- + ! compute residual and sum its squared components + !----------------------------------------------------------------- + + if (present(sum_squared)) then + sum_squared = c0 + endif + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + Fx(i,j) = bx(i,j) - Au(i,j) + Fy(i,j) = by(i,j) - Av(i,j) + if (present(sum_squared)) then + sum_squared = sum_squared + Fx(i,j)**2 + Fy(i,j)**2 + endif + enddo ! ij + + end subroutine residual_vec + +!======================================================================= + +! Form the diagonal of the matrix A(u,v) (first part of the computation) +! Part 1: compute the contributions to the diagonal from the rheology term + + subroutine formDiag_step1 (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + dxt , dyt , & + dxhy , dyhx , & + cxp , cyp , & + cxm , cym , & + zetaD , Drheo) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! no. of cells where icetmask = 1 + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + 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 + + real (kind=dbl_kind), dimension(nx_block,ny_block,4), intent(in) :: & + zetaD ! 2*zeta + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(out) :: & + Drheo ! intermediate value for diagonal components of matrix A associated + ! with rheology term + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij, iu, ju, di, dj, cc + + real (kind=dbl_kind) :: & + divune, divunw, divuse, divusw , & ! divergence + tensionne, tensionnw, tensionse, tensionsw, & ! tension + shearne, shearnw, shearse, shearsw , & ! shearing + uij,ui1j,uij1,ui1j1,vij,vi1j,vij1,vi1j1 , & ! == c0 or c1 + stressp_1, stressp_2, stressp_3, stressp_4, & + stressm_1, stressm_2, stressm_3, stressm_4, & + stress12_1,stress12_2,stress12_3,stress12_4,& + 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 + + character(len=*), parameter :: subname = '(formDiag_step1)' + + !----------------------------------------------------------------- + ! Initialize + !----------------------------------------------------------------- + + Drheo(:,:,:) = c0 + + ! Be careful: Drheo contains 4 terms for u and 4 terms for v. + ! These 8 terms come from the surrounding T cells but are all + ! refrerenced to the i,j (u point) : + + ! Drheo(i,j,1) corresponds to str(i,j,1) + ! Drheo(i,j,2) corresponds to str(i+1,j,2) + ! Drheo(i,j,3) corresponds to str(i,j+1,3) + ! Drheo(i,j,4) corresponds to str(i+1,j+1,4)) + ! Drheo(i,j,5) corresponds to str(i,j,5) + ! Drheo(i,j,6) corresponds to str(i,j+1,6) + ! Drheo(i,j,7) corresponds to str(i+1,j,7) + ! Drheo(i,j,8) corresponds to str(i+1,j+1,8)) + + do cc = 1, 8 ! 4 for u and 4 for v + + if (cc == 1) then ! u comp, T cell i,j + uij = c1 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 0 + elseif (cc == 2) then ! u comp, T cell i+1,j + uij = c0 + ui1j = c1 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 0 + elseif (cc == 3) then ! u comp, T cell i,j+1 + uij = c0 + ui1j = c0 + uij1 = c1 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 1 + elseif (cc == 4) then ! u comp, T cell i+1,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c1 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 1 + elseif (cc == 5) then ! v comp, T cell i,j + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c1 + vi1j = c0 + vij1 = c0 + vi1j1 = c0 + di = 0 + dj = 0 + elseif (cc == 6) then ! v comp, T cell i,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c1 + vi1j1 = c0 + di = 0 + dj = 1 + elseif (cc == 7) then ! v comp, T cell i+1,j + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c1 + vij1 = c0 + vi1j1 = c0 + di = 1 + dj = 0 + elseif (cc == 8) then ! v comp, T cell i+1,j+1 + uij = c0 + ui1j = c0 + uij1 = c0 + ui1j1 = c0 + vij = c0 + vi1j = c0 + vij1 = c0 + vi1j1 = c1 + di = 1 + dj = 1 + endif + + do ij = 1, icellu + + iu = indxui(ij) + ju = indxuj(ij) + i = iu + di + j = ju + dj + + !----------------------------------------------------------------- + ! strain rates + ! NOTE these are actually strain rates * area (m^2/s) + !----------------------------------------------------------------- + ! divergence = e_11 + e_22 + divune = cyp(i,j)*uij - dyt(i,j)*ui1j & + + cxp(i,j)*vij - dxt(i,j)*vij1 + divunw = cym(i,j)*ui1j + dyt(i,j)*uij & + + cxp(i,j)*vi1j - dxt(i,j)*vi1j1 + divusw = cym(i,j)*ui1j1 + dyt(i,j)*uij1 & + + cxm(i,j)*vi1j1 + dxt(i,j)*vi1j + divuse = cyp(i,j)*uij1 - dyt(i,j)*ui1j1 & + + cxm(i,j)*vij1 + dxt(i,j)*vij + + ! tension strain rate = e_11 - e_22 + tensionne = -cym(i,j)*uij - dyt(i,j)*ui1j & + + cxm(i,j)*vij + dxt(i,j)*vij1 + tensionnw = -cyp(i,j)*ui1j + dyt(i,j)*uij & + + cxm(i,j)*vi1j + dxt(i,j)*vi1j1 + tensionsw = -cyp(i,j)*ui1j1 + dyt(i,j)*uij1 & + + cxp(i,j)*vi1j1 - dxt(i,j)*vi1j + tensionse = -cym(i,j)*uij1 - dyt(i,j)*ui1j1 & + + cxp(i,j)*vij1 - dxt(i,j)*vij + + ! shearing strain rate = 2*e_12 + shearne = -cym(i,j)*vij - dyt(i,j)*vi1j & + - cxm(i,j)*uij - dxt(i,j)*uij1 + shearnw = -cyp(i,j)*vi1j + dyt(i,j)*vij & + - cxm(i,j)*ui1j - dxt(i,j)*ui1j1 + shearsw = -cyp(i,j)*vi1j1 + dyt(i,j)*vij1 & + - cxp(i,j)*ui1j1 + dxt(i,j)*ui1j + shearse = -cym(i,j)*vij1 - dyt(i,j)*vi1j1 & + - cxp(i,j)*uij1 + dxt(i,j)*uij + + !----------------------------------------------------------------- + ! the stresses ! kg/s^2 + ! (1) northeast, (2) northwest, (3) southwest, (4) southeast + !----------------------------------------------------------------- + + stressp_1 = zetaD(i,j,1)*divune*(c1+Ktens) + stressp_2 = zetaD(i,j,2)*divunw*(c1+Ktens) + stressp_3 = zetaD(i,j,3)*divusw*(c1+Ktens) + stressp_4 = zetaD(i,j,4)*divuse*(c1+Ktens) + + stressm_1 = zetaD(i,j,1)*tensionne*(c1+Ktens)*ecci + stressm_2 = zetaD(i,j,2)*tensionnw*(c1+Ktens)*ecci + stressm_3 = zetaD(i,j,3)*tensionsw*(c1+Ktens)*ecci + stressm_4 = zetaD(i,j,4)*tensionse*(c1+Ktens)*ecci + + stress12_1 = zetaD(i,j,1)*shearne*p5*(c1+Ktens)*ecci + stress12_2 = zetaD(i,j,2)*shearnw*p5*(c1+Ktens)*ecci + stress12_3 = zetaD(i,j,3)*shearsw*p5*(c1+Ktens)*ecci + stress12_4 = zetaD(i,j,4)*shearse*p5*(c1+Ktens)*ecci + + !----------------------------------------------------------------- + ! combinations of the stresses for the momentum equation ! kg/s^2 + !----------------------------------------------------------------- + + ssigpn = stressp_1 + stressp_2 + ssigps = stressp_3 + stressp_4 + ssigpe = stressp_1 + stressp_4 + ssigpw = stressp_2 + stressp_3 + ssigp1 =(stressp_1 + stressp_3)*p055 + ssigp2 =(stressp_2 + stressp_4)*p055 + + ssigmn = stressm_1 + stressm_2 + ssigms = stressm_3 + stressm_4 + ssigme = stressm_1 + stressm_4 + ssigmw = stressm_2 + stressm_3 + ssigm1 =(stressm_1 + stressm_3)*p055 + ssigm2 =(stressm_2 + stressm_4)*p055 + + ssig12n = stress12_1 + stress12_2 + ssig12s = stress12_3 + stress12_4 + ssig12e = stress12_1 + stress12_4 + ssig12w = stress12_2 + stress12_3 + ssig121 =(stress12_1 + stress12_3)*p111 + ssig122 =(stress12_2 + stress12_4)*p111 + + csigpne = p111*stressp_1 + ssigp2 + p027*stressp_3 + csigpnw = p111*stressp_2 + ssigp1 + p027*stressp_4 + csigpsw = p111*stressp_3 + ssigp2 + p027*stressp_1 + csigpse = p111*stressp_4 + ssigp1 + p027*stressp_2 + + csigmne = p111*stressm_1 + ssigm2 + p027*stressm_3 + csigmnw = p111*stressm_2 + ssigm1 + p027*stressm_4 + csigmsw = p111*stressm_3 + ssigm2 + p027*stressm_1 + csigmse = p111*stressm_4 + ssigm1 + p027*stressm_2 + + csig12ne = p222*stress12_1 + ssig122 & + + p055*stress12_3 + csig12nw = p222*stress12_2 + ssig121 & + + p055*stress12_4 + csig12sw = p222*stress12_3 + ssig122 & + + p055*stress12_1 + csig12se = p222*stress12_4 + ssig121 & + + p055*stress12_2 + + str12ew = p5*dxt(i,j)*(p333*ssig12e + p166*ssig12w) + str12we = p5*dxt(i,j)*(p333*ssig12w + p166*ssig12e) + str12ns = p5*dyt(i,j)*(p333*ssig12n + p166*ssig12s) + str12sn = p5*dyt(i,j)*(p333*ssig12s + p166*ssig12n) + + !----------------------------------------------------------------- + ! for dF/dx (u momentum) + !----------------------------------------------------------------- + + if (cc == 1) then ! T cell i,j + + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northeast (i,j) + Drheo(iu,ju,1) = -strp_tmp - strm_tmp - str12ew & + + dxhy(i,j)*(-csigpne + csigmne) + dyhx(i,j)*csig12ne + + elseif (cc == 2) then ! T cell i+1,j + + strp_tmp = p25*dyt(i,j)*(p333*ssigpn + p166*ssigps) + strm_tmp = p25*dyt(i,j)*(p333*ssigmn + p166*ssigms) + + ! northwest (i+1,j) + Drheo(iu,ju,2) = strp_tmp + strm_tmp - str12we & + + dxhy(i,j)*(-csigpnw + csigmnw) + dyhx(i,j)*csig12nw + + elseif (cc == 3) then ! T cell i,j+1 + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southeast (i,j+1) + Drheo(iu,ju,3) = -strp_tmp - strm_tmp + str12ew & + + dxhy(i,j)*(-csigpse + csigmse) + dyhx(i,j)*csig12se + + elseif (cc == 4) then ! T cell i+1,j+1 + + strp_tmp = p25*dyt(i,j)*(p333*ssigps + p166*ssigpn) + strm_tmp = p25*dyt(i,j)*(p333*ssigms + p166*ssigmn) + + ! southwest (i+1,j+1) + Drheo(iu,ju,4) = strp_tmp + strm_tmp + str12we & + + dxhy(i,j)*(-csigpsw + csigmsw) + dyhx(i,j)*csig12sw + + !----------------------------------------------------------------- + ! for dF/dy (v momentum) + !----------------------------------------------------------------- + + elseif (cc == 5) then ! T cell i,j + + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! northeast (i,j) + Drheo(iu,ju,5) = -strp_tmp + strm_tmp - str12ns & + - dyhx(i,j)*(csigpne + csigmne) + dxhy(i,j)*csig12ne + + elseif (cc == 6) then ! T cell i,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpe + p166*ssigpw) + strm_tmp = p25*dxt(i,j)*(p333*ssigme + p166*ssigmw) + + ! southeast (i,j+1) + Drheo(iu,ju,6) = strp_tmp - strm_tmp - str12sn & + - dyhx(i,j)*(csigpse + csigmse) + dxhy(i,j)*csig12se + + elseif (cc == 7) then ! T cell i,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! northwest (i+1,j) + Drheo(iu,ju,7) = -strp_tmp + strm_tmp + str12ns & + - dyhx(i,j)*(csigpnw + csigmnw) + dxhy(i,j)*csig12nw + + elseif (cc == 8) then ! T cell i+1,j+1 + + strp_tmp = p25*dxt(i,j)*(p333*ssigpw + p166*ssigpe) + strm_tmp = p25*dxt(i,j)*(p333*ssigmw + p166*ssigme) + + ! southwest (i+1,j+1) + Drheo(iu,ju,8) = strp_tmp - strm_tmp + str12sn & + - dyhx(i,j)*(csigpsw + csigmsw) + dxhy(i,j)*csig12sw + + endif + + enddo ! ij + + enddo ! cc + + end subroutine formDiag_step1 + +!======================================================================= + +! Form the diagonal of the matrix A(u,v) (second part of the computation) +! Part 2: compute diagonal + + subroutine formDiag_step2 (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + Drheo , vrel , & + umassdti, & + uarear , Cb , & + diagx , diagy) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + vrel, & ! coefficient for tauw + Cb, & ! coefficient for basal stress + umassdti, & ! mass of U-cell/dt (kg/m^2 s) + uarear ! 1/uarea + + real (kind=dbl_kind), dimension(nx_block,ny_block,8), intent(in) :: & + Drheo + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(out) :: & + diagx , & ! Diagonal (x component) of the matrix A + diagy ! Diagonal (y component) of the matrix A + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + real (kind=dbl_kind) :: & + ccaimp , & ! intermediate variables + strintx, strinty ! diagonal contributions to the divergence + + character(len=*), parameter :: subname = '(formDiag_step2)' + + !----------------------------------------------------------------- + ! integrate the momentum equation + !----------------------------------------------------------------- + + strintx = c0 + strinty = c0 + + ! Be careful: Drheo contains 4 terms for u and 4 terms for v. + ! These 8 terms come from the surrounding T cells but are all + ! refrerenced to the i,j (u point) : + + ! Drheo(i,j,1) corresponds to str(i,j,1) + ! Drheo(i,j,2) corresponds to str(i+1,j,2) + ! Drheo(i,j,3) corresponds to str(i,j+1,3) + ! Drheo(i,j,4) corresponds to str(i+1,j+1,4)) + ! Drheo(i,j,5) corresponds to str(i,j,5) + ! Drheo(i,j,6) corresponds to str(i,j+1,6) + ! Drheo(i,j,7) corresponds to str(i+1,j,7) + ! Drheo(i,j,8) corresponds to str(i+1,j+1,8)) + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + ccaimp = umassdti(i,j) + vrel(i,j) * cosw + Cb(i,j) ! kg/m^2 s + + strintx = uarear(i,j)* & + (Drheo(i,j,1) + Drheo(i,j,2) + Drheo(i,j,3) + Drheo(i,j,4)) + strinty = uarear(i,j)* & + (Drheo(i,j,5) + Drheo(i,j,6) + Drheo(i,j,7) + Drheo(i,j,8)) + + diagx(i,j) = ccaimp - strintx + diagy(i,j) = ccaimp - strinty + enddo ! ij + + end subroutine formDiag_step2 + +!======================================================================= + +! Compute squared l^2 norm of a grid function (tpu,tpv) + + subroutine calc_L2norm_squared (nx_block, ny_block, & + icellu , & + indxui , indxuj , & + tpu , tpv , & + L2norm) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + icellu ! total count when iceumask is true + + integer (kind=int_kind), dimension (nx_block*ny_block), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block), intent(in) :: & + tpu , & ! x-component of vector grid function + tpv ! y-component of vector grid function + + real (kind=dbl_kind), intent(out) :: & + L2norm ! squared l^2 norm of vector grid function (tpu,tpv) + + ! local variables + + integer (kind=int_kind) :: & + i, j, ij + + character(len=*), parameter :: subname = '(calc_L2norm_squared)' + + !----------------------------------------------------------------- + ! compute squared l^2 norm of vector grid function (tpu,tpv) + !----------------------------------------------------------------- + + L2norm = c0 + + do ij = 1, icellu + i = indxui(ij) + j = indxuj(ij) + + L2norm = L2norm + tpu(i,j)**2 + tpv(i,j)**2 + enddo ! ij + + end subroutine calc_L2norm_squared + +!======================================================================= + +! Convert a grid function (tpu,tpv) to a one dimensional vector + + subroutine arrays_to_vec (nx_block, ny_block , & + nblocks , max_blocks, & + icellu , ntot , & + indxui , indxuj , & + tpu , tpv , & + outvec) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + nblocks, & ! nb of blocks + max_blocks, & ! max nb of blocks + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension (max_blocks), intent(in) :: & + icellu + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (nx_block,ny_block, max_blocks), intent(in) :: & + tpu , & ! x-component of vector + tpv ! y-component of vector + + real (kind=dbl_kind), dimension (ntot), intent(out) :: & + outvec ! output 1D vector + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, tot, ij + + character(len=*), parameter :: subname = '(arrays_to_vec)' + + !----------------------------------------------------------------- + ! form vector (converts from max_blocks arrays to single vector) + !----------------------------------------------------------------- + + outvec(:) = c0 + tot = 0 + + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + tot = tot + 1 + outvec(tot) = tpu(i, j, iblk) + tot = tot + 1 + outvec(tot) = tpv(i, j, iblk) + enddo + enddo ! ij + + end subroutine arrays_to_vec + +!======================================================================= + +! Convert one dimensional vector to a grid function (tpu,tpv) + + subroutine vec_to_arrays (nx_block, ny_block , & + nblocks , max_blocks, & + icellu , ntot , & + indxui , indxuj , & + invec , & + tpu , tpv) + + integer (kind=int_kind), intent(in) :: & + nx_block, ny_block, & ! block dimensions + nblocks, & ! nb of blocks + max_blocks, & ! max nb of blocks + ntot ! size of problem for Anderson + + integer (kind=int_kind), dimension (max_blocks), intent(in) :: & + icellu + + integer (kind=int_kind), dimension (nx_block*ny_block, max_blocks), intent(in) :: & + indxui , & ! compressed index in i-direction + indxuj ! compressed index in j-direction + + real (kind=dbl_kind), dimension (ntot), intent(in) :: & + invec ! input 1D vector + + real (kind=dbl_kind), dimension (nx_block,ny_block, max_blocks), intent(out) :: & + tpu , & ! x-component of vector + tpv ! y-component of vector + + ! local variables + + integer (kind=int_kind) :: & + i, j, iblk, tot, ij + + character(len=*), parameter :: subname = '(vec_to_arrays)' + + !----------------------------------------------------------------- + ! form arrays (converts from vector to the max_blocks arrays) + !----------------------------------------------------------------- + + tpu(:,:,:) = c0 + tpv(:,:,:) = c0 + tot = 0 + + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + tot = tot + 1 + tpu(i, j, iblk) = invec(tot) + tot = tot + 1 + tpv(i, j, iblk) = invec(tot) + enddo + enddo! ij + + end subroutine vec_to_arrays + +!======================================================================= + +! Update Q and R factors after deletion of the 1st column of G_diff +! +! author: P. Blain ECCC +! +! adapted from : +! H. F. Walker, “Anderson Acceleration: Algorithms and Implementations” +! [Online]. Available: https://users.wpi.edu/~walker/Papers/anderson_accn_algs_imps.pdf + + subroutine qr_delete(Q, R) + + real (kind=dbl_kind), intent(inout) :: & + Q(:,:), & ! Q factor + R(:,:) ! R factor + + ! local variables + + integer (kind=int_kind) :: & + i, j, k, & ! loop indices + m, n ! size of Q matrix + + real (kind=dbl_kind) :: & + temp, c, s + + character(len=*), parameter :: subname = '(qr_delete)' + + n = size(Q, 1) + m = size(Q, 2) + do i = 1, m-1 + temp = sqrt(R(i, i+1)**2 + R(i+1, i+1)**2) + c = R(i , i+1) / temp + s = R(i+1, i+1) / temp + R(i , i+1) = temp + R(i+1, i+1) = 0 + if (i < m-1) then + do j = i+2, m + temp = c*R(i, j) + s*R(i+1, j) + R(i+1, j) = -s*R(i, j) + c*R(i+1, j) + R(i , j) = temp + enddo + endif + do k = 1, n + temp = c*Q(k, i) + s*Q(k, i+1); + Q(k, i+1) = -s*Q(k, i) + c*Q(k, i+1); + Q(k, i) = temp + enddo + enddo + R(:, 1:m-1) = R(:, 2:m) + + end subroutine qr_delete + +!======================================================================= + +! FGMRES: Flexible generalized minimum residual method (with restarts). +! Solves the linear system A x = b using GMRES with a varying (right) preconditioner +! +! authors: Stéphane Gaudreault, Abdessamad Qaddouri, Philippe Blain, ECCC + + subroutine fgmres (zetaD , & + Cb , vrel , & + umassdti , & + halo_info_mask , & + bx , by , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + solx , soly , & + nbiter) + + use ice_boundary, only: ice_HaloUpdate + use ice_domain, only: maskhalo_dyn, halo_info + use ice_timers, only: ice_timer_start, ice_timer_stop, timer_bound + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + type (ice_halo), intent(in) :: & + halo_info_mask ! ghost cell update info for masked halo + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + bx , & ! Right hand side of the linear system (x components) + by , & ! Right hand side of the linear system (y components) + diagx , & ! Diagonal of the system matrix (x components) + diagy ! Diagonal of the system matrix (y components) + + real (kind=dbl_kind), intent(in) :: & + tolerance ! Tolerance to achieve. The algorithm terminates when the relative + ! residual is below tolerance + + integer (kind=int_kind), intent(in) :: & + maxinner, & ! Restart the method every maxinner inner (Arnoldi) iterations + maxouter ! Maximum number of outer (restarts) iterations + ! Iteration will stop after maxinner*maxouter Arnoldi steps + ! even if the specified tolerance has not been achieved + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & + solx , & ! Initial guess on input, approximate solution on output (x components) + soly ! Initial guess on input, approximate solution on output (y components) + + integer (kind=int_kind), intent(out) :: & + nbiter ! Total number of Arnoldi iterations performed + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! index for indx[t|u][i|j] + i, j ! grid indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + workspace_x , & ! work vector (x components) + workspace_y ! work vector (y components) + + real (kind=dbl_kind), dimension (max_blocks) :: & + norm_squared ! array to accumulate squared norm of grid function over blocks + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1) :: & + arnoldi_basis_x , & ! Arnoldi basis (x components) + arnoldi_basis_y ! Arnoldi basis (y components) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner) :: & + orig_basis_x , & ! original basis (x components) + orig_basis_y ! original basis (y components) + + real (kind=dbl_kind) :: & + norm_residual , & ! current L^2 norm of residual vector + inverse_norm , & ! inverse of the norm of a vector + nu, t ! local temporary values + + integer (kind=int_kind) :: & + initer , & ! inner (Arnoldi) loop counter + outiter , & ! outer (restarts) loop counter + nextit , & ! nextit == initer+1 + it, k, ii, jj ! reusable loop counters + + real (kind=dbl_kind), dimension(maxinner+1) :: & + rot_cos , & ! cosine elements of Givens rotations + rot_sin , & ! sine elements of Givens rotations + rhs_hess ! right hand side vector of the Hessenberg (least squares) system + + real (kind=dbl_kind), dimension(maxinner+1, maxinner) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + character (len=char_len) :: & + precond_type ! type of preconditioner + + real (kind=dbl_kind) :: & + relative_tolerance ! relative_tolerance, i.e. tolerance*norm(initial residual) + + character(len=*), parameter :: subname = '(fgmres)' + + ! Here we go ! + + ! Initialize + outiter = 0 + nbiter = 0 + + norm_squared = c0 + precond_type = precond + + ! Cells with no ice should be zero-initialized + workspace_x = c0 + workspace_y = c0 + arnoldi_basis_x = c0 + arnoldi_basis_y = c0 + + ! Residual of the initial iterate + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + solx (:,:,iblk) , soly (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + workspace_x(:,:,iblk), workspace_y(:,:,iblk), & + arnoldi_basis_x (:,:,iblk, 1), & + arnoldi_basis_y (:,:,iblk, 1)) + enddo + !$OMP END PARALLEL DO + + ! Start outer (restarts) loop + do + ! Compute norm of initial residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:,iblk), & + arnoldi_basis_x(:,:,iblk, 1) , & + arnoldi_basis_y(:,:,iblk, 1) , & + norm_squared(iblk)) + + enddo + !$OMP END PARALLEL DO + norm_residual = sqrt(global_sum(sum(norm_squared), distrb_info)) + + if (my_task == master_task .and. monitor_fgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_fgmres: iter_fgmres= ", nbiter, & + " fgmres_L2norm= ", norm_residual + endif + + ! Current guess is a good enough solution TODO: reactivate and test this + ! if (norm_residual < tolerance) then + ! return + ! end if + + ! Normalize the first Arnoldi vector + inverse_norm = c1 / norm_residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, 1) = arnoldi_basis_x(i, j, iblk, 1) * inverse_norm + arnoldi_basis_y(i, j, iblk, 1) = arnoldi_basis_y(i, j, iblk, 1) * inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + + if (outiter == 0) then + relative_tolerance = tolerance * norm_residual + end if + + ! Initialize 1-st term of RHS of Hessenberg system + rhs_hess(1) = norm_residual + rhs_hess(2:) = c0 + + initer = 0 + + ! Start of inner (Arnoldi) loop + do + + nbiter = nbiter + 1 + initer = initer + 1 + nextit = initer + 1 + ! precondition the current Arnoldi vector + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + arnoldi_basis_x(:,:,:,initer), & + arnoldi_basis_y(:,:,:,initer), & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + orig_basis_x(:,:,:,initer) = workspace_x + orig_basis_y(:,:,:,initer) = workspace_y + + ! Update workspace with boundary values + call stack_velocity_field(workspace_x, workspace_y, 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, workspace_x, workspace_y) + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + arnoldi_basis_x(:,:,iblk,nextit), & + arnoldi_basis_y(:,:,iblk,nextit)) + enddo + !$OMP END PARALLEL DO + + ! Orthogonalize the new vector + call orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + ! Compute norm of new Arnoldi vector and update Hessenberg matrix + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk) , & + arnoldi_basis_x(:,:,iblk, nextit), & + arnoldi_basis_y(:,:,iblk, nextit), & + norm_squared(iblk)) + enddo + !$OMP END PARALLEL DO + hessenberg(nextit,initer) = sqrt(global_sum(sum(norm_squared), distrb_info)) + + ! Watch out for happy breakdown + if (.not. almost_zero( hessenberg(nextit,initer) ) ) then + ! Normalize next Arnoldi vector + inverse_norm = c1 / hessenberg(nextit,initer) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit)*inverse_norm + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit)*inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + end if + + ! Apply previous Givens rotation to the last column of the Hessenberg matrix + if (initer > 1) then + do k = 2, initer + t = hessenberg(k-1, initer) + hessenberg(k-1, initer) = rot_cos(k-1)*t + rot_sin(k-1)*hessenberg(k, initer) + hessenberg(k, initer) = -rot_sin(k-1)*t + rot_cos(k-1)*hessenberg(k, initer) + end do + end if + + ! Compute and apply new Givens rotation + nu = sqrt(hessenberg(initer,initer)**2 + hessenberg(nextit,initer)**2) + if (.not. almost_zero(nu)) then + rot_cos(initer) = hessenberg(initer,initer) / nu + rot_sin(initer) = hessenberg(nextit,initer) / nu + + rhs_hess(nextit) = -rot_sin(initer) * rhs_hess(initer) + rhs_hess(initer) = rot_cos(initer) * rhs_hess(initer) + + hessenberg(initer,initer) = rot_cos(initer) * hessenberg(initer,initer) + rot_sin(initer) * hessenberg(nextit,initer) + end if + + ! Check for convergence + norm_residual = abs(rhs_hess(nextit)) + + if (my_task == master_task .and. monitor_fgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_fgmres: iter_fgmres= ", nbiter, & + " fgmres_L2norm= ", norm_residual + endif + + if ((initer >= maxinner) .or. (norm_residual <= relative_tolerance)) then + exit + endif + + end do ! end of inner (Arnoldi) loop + + ! At this point either the maximum number of inner iterations + ! was reached or the absolute residual is below the scaled tolerance. + + ! Solve the (now upper triangular) system "hessenberg * sol_hess = rhs_hess" + ! (sol_hess is stored in rhs_hess) + rhs_hess(initer) = rhs_hess(initer) / hessenberg(initer,initer) + do ii = 2, initer + k = initer - ii + 1 + t = rhs_hess(k) + do j = k + 1, initer + t = t - hessenberg(k,j) * rhs_hess(j) + end do + rhs_hess(k) = t / hessenberg(k,k) + end do + + ! Form linear combination to get new solution iterate + do it = 1, initer + t = rhs_hess(it) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + solx(i, j, iblk) = solx(i, j, iblk) + t * orig_basis_x(i, j, iblk, it) + soly(i, j, iblk) = soly(i, j, iblk) + t * orig_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + + ! Increment outer loop counter and check for convergence + outiter = outiter + 1 + if (norm_residual <= relative_tolerance .or. outiter >= maxouter) then + return + end if + + ! Solution is not convergent : compute residual vector and continue. + + ! The residual vector is computed here using (see Saad p. 177) : + ! \begin{equation} + ! r = V_{m+1} * Q_m^T * (\gamma_{m+1} * e_{m+1}) + ! \end{equation} + ! where : + ! $r$ is the residual + ! $V_{m+1}$ is a matrix whose columns are the Arnoldi vectors from 1 to nextit (m+1) + ! $Q_m$ is the product of the Givens rotation : Q_m = G_m G_{m-1} ... G_1 + ! $gamma_{m+1}$ is the last element of rhs_hess + ! $e_{m+1})$ is the unit vector (0, 0, ..., 1)^T \in \reals^{m+1} + + ! Apply the Givens rotation in reverse order to g := \gamma_{m+1} * e_{m+1}, + ! store the result in rhs_hess + do it = 1, initer + jj = nextit - it + 1 + rhs_hess(jj-1) = -rot_sin(jj-1) * rhs_hess(jj) ! + rot_cos(jj-1) * g(jj-1) (== 0) + rhs_hess(jj) = rot_cos(jj-1) * rhs_hess(jj) ! + rot_sin(jj-1) * g(jj-1) (== 0) + end do + + ! Compute the residual by multiplying V_{m+1} and rhs_hess + workspace_x = c0 + workspace_y = c0 + do it = 1, nextit + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + arnoldi_basis_x(:,:,:,1) = workspace_x + arnoldi_basis_y(:,:,:,1) = workspace_y + end do + end do ! end of outer (restarts) loop + + end subroutine fgmres + +!======================================================================= + +! PGMRES: Right-preconditioned generalized minimum residual method (with restarts). +! Solves the linear A x = b using GMRES with a right preconditioner +! +! authors: Stéphane Gaudreault, Abdessamad Qaddouri, Philippe Blain, ECCC + + subroutine pgmres (zetaD , & + Cb , vrel , & + umassdti , & + bx , by , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + solx , soly , & + nbiter) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + bx , & ! Right hand side of the linear system (x components) + by ! Right hand side of the linear system (y components) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + diagx , & ! Diagonal of the system matrix (x components) + diagy ! Diagonal of the system matrix (y components) + + real (kind=dbl_kind), intent(in) :: & + tolerance ! Tolerance to achieve. The algorithm terminates when the relative + ! residual is below tolerance + + integer (kind=int_kind), intent(in) :: & + maxinner, & ! Restart the method every maxinner inner (Arnoldi) iterations + maxouter ! Maximum number of outer (restarts) iterations + ! Iteration will stop after maxinner*maxouter Arnoldi steps + ! even if the specified tolerance has not been achieved + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(inout) :: & + solx , & ! Initial guess on input, approximate solution on output (x components) + soly ! Initial guess on input, approximate solution on output (y components) + + integer (kind=int_kind), intent(out) :: & + nbiter ! Total number of Arnoldi iterations performed + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! index for indx[t|u][i|j] + i, j ! grid indices + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + workspace_x , & ! work vector (x components) + workspace_y ! work vector (y components) + + real (kind=dbl_kind), dimension (max_blocks) :: & + norm_squared ! array to accumulate squared norm of grid function over blocks + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1) :: & + arnoldi_basis_x , & ! Arnoldi basis (x components) + arnoldi_basis_y ! Arnoldi basis (y components) + + real (kind=dbl_kind) :: & + norm_residual , & ! current L^2 norm of residual vector + inverse_norm , & ! inverse of the norm of a vector + nu, t ! local temporary values + + integer (kind=int_kind) :: & + initer , & ! inner (Arnoldi) loop counter + outiter , & ! outer (restarts) loop counter + nextit , & ! nextit == initer+1 + it, k, ii, jj ! reusable loop counters + + real (kind=dbl_kind), dimension(maxinner+1) :: & + rot_cos , & ! cosine elements of Givens rotations + rot_sin , & ! sine elements of Givens rotations + rhs_hess ! right hand side vector of the Hessenberg (least squares) system + + real (kind=dbl_kind), dimension(maxinner+1, maxinner) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + character(len=char_len) :: & + precond_type , & ! type of preconditioner + ortho_type ! type of orthogonalization + + real (kind=dbl_kind) :: & + relative_tolerance ! relative_tolerance, i.e. tolerance*norm(initial residual) + + character(len=*), parameter :: subname = '(pgmres)' + + ! Here we go ! + + ! Initialize + outiter = 0 + nbiter = 0 + + norm_squared = c0 + precond_type = 'diag' ! Jacobi preconditioner + ortho_type = 'cgs' ! classical gram-schmidt TODO: try with MGS + + ! Cells with no ice should be zero-initialized + workspace_x = c0 + workspace_y = c0 + arnoldi_basis_x = c0 + arnoldi_basis_y = c0 + + ! Residual of the initial iterate + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + solx (:,:,iblk) , soly (:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk)) + call residual_vec (nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj (:,iblk), & + bx (:,:,iblk), by (:,:,iblk), & + workspace_x(:,:,iblk), workspace_y(:,:,iblk), & + arnoldi_basis_x (:,:,iblk, 1), & + arnoldi_basis_y (:,:,iblk, 1)) + enddo + !$OMP END PARALLEL DO + + ! Start outer (restarts) loop + do + ! Compute norm of initial residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk), & + arnoldi_basis_x(:,:,iblk, 1), & + arnoldi_basis_y(:,:,iblk, 1), & + norm_squared(iblk)) + + enddo + !$OMP END PARALLEL DO + norm_residual = sqrt(global_sum(sum(norm_squared), distrb_info)) + + if (my_task == master_task .and. monitor_pgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_pgmres: iter_pgmres= ", nbiter, & + " pgmres_L2norm= ", norm_residual + endif + + ! Current guess is a good enough solution + ! if (norm_residual < tolerance) then + ! return + ! end if + + ! Normalize the first Arnoldi vector + inverse_norm = c1 / norm_residual + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, 1) = arnoldi_basis_x(i, j, iblk, 1) * inverse_norm + arnoldi_basis_y(i, j, iblk, 1) = arnoldi_basis_y(i, j, iblk, 1) * inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + + if (outiter == 0) then + relative_tolerance = tolerance * norm_residual + end if + + ! Initialize 1-st term of RHS of Hessenberg system + rhs_hess(1) = norm_residual + rhs_hess(2:) = c0 + + initer = 0 + + ! Start of inner (Arnoldi) loop + do + + nbiter = nbiter + 1 + initer = initer + 1 + nextit = initer + 1 + + ! precondition the current Arnoldi vector + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + arnoldi_basis_x(:,:,:,initer), & + arnoldi_basis_y(:,:,:,initer), & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + + ! NOTE: halo updates for (workspace_x, workspace_y) + ! are skipped here for efficiency since this is just a preconditioner + + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call matvec (nx_block , ny_block , & + icellu (iblk) , icellt (iblk), & + indxui (:,iblk) , indxuj (:,iblk), & + indxti (:,iblk) , indxtj (:,iblk), & + dxt (:,:,iblk) , dyt (:,:,iblk), & + dxhy (:,:,iblk) , dyhx (:,:,iblk), & + cxp (:,:,iblk) , cyp (:,:,iblk), & + cxm (:,:,iblk) , cym (:,:,iblk), & + workspace_x(:,:,iblk) , workspace_y(:,:,iblk), & + vrel (:,:,iblk) , Cb (:,:,iblk), & + zetaD (:,:,iblk,:), & + umassdti (:,:,iblk) , fm (:,:,iblk), & + uarear (:,:,iblk) , & + arnoldi_basis_x(:,:,iblk,nextit), & + arnoldi_basis_y(:,:,iblk,nextit)) + enddo + !$OMP END PARALLEL DO + + ! Orthogonalize the new vector + call orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + ! Compute norm of new Arnoldi vector and update Hessenberg matrix + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + call calc_L2norm_squared(nx_block , ny_block , & + icellu (iblk), & + indxui (:,iblk), indxuj(:, iblk) , & + arnoldi_basis_x(:,:,iblk, nextit), & + arnoldi_basis_y(:,:,iblk, nextit), & + norm_squared(iblk)) + enddo + !$OMP END PARALLEL DO + hessenberg(nextit,initer) = sqrt(global_sum(sum(norm_squared), distrb_info)) + + ! Watch out for happy breakdown + if (.not. almost_zero( hessenberg(nextit,initer) ) ) then + ! Normalize next Arnoldi vector + inverse_norm = c1 / hessenberg(nextit,initer) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit)*inverse_norm + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit)*inverse_norm + enddo ! ij + enddo + !$OMP END PARALLEL DO + end if + + ! Apply previous Givens rotation to the last column of the Hessenberg matrix + if (initer > 1) then + do k = 2, initer + t = hessenberg(k-1, initer) + hessenberg(k-1, initer) = rot_cos(k-1)*t + rot_sin(k-1)*hessenberg(k, initer) + hessenberg(k, initer) = -rot_sin(k-1)*t + rot_cos(k-1)*hessenberg(k, initer) + end do + end if + + ! Compute and apply new Givens rotation + nu = sqrt(hessenberg(initer,initer)**2 + hessenberg(nextit,initer)**2) + if (.not. almost_zero(nu)) then + rot_cos(initer) = hessenberg(initer,initer) / nu + rot_sin(initer) = hessenberg(nextit,initer) / nu + + rhs_hess(nextit) = -rot_sin(initer) * rhs_hess(initer) + rhs_hess(initer) = rot_cos(initer) * rhs_hess(initer) + + hessenberg(initer,initer) = rot_cos(initer) * hessenberg(initer,initer) + rot_sin(initer) * hessenberg(nextit,initer) + end if + + ! Check for convergence + norm_residual = abs(rhs_hess(nextit)) + + if (my_task == master_task .and. monitor_pgmres) then + write(nu_diag, '(a,i4,a,d26.16)') "monitor_pgmres: iter_pgmres= ", nbiter, & + " pgmres_L2norm= ", norm_residual + endif + + if ((initer >= maxinner) .or. (norm_residual <= relative_tolerance)) then + exit + endif + + end do ! end of inner (Arnoldi) loop + + ! At this point either the maximum number of inner iterations + ! was reached or the absolute residual is below the scaled tolerance. + + ! Solve the (now upper triangular) system "hessenberg * sol_hess = rhs_hess" + ! (sol_hess is stored in rhs_hess) + rhs_hess(initer) = rhs_hess(initer) / hessenberg(initer,initer) + do ii = 2, initer + k = initer - ii + 1 + t = rhs_hess(k) + do j = k + 1, initer + t = t - hessenberg(k,j) * rhs_hess(j) + end do + rhs_hess(k) = t / hessenberg(k,k) + end do + + ! Form linear combination to get new solution iterate + workspace_x = c0 + workspace_y = c0 + do it = 1, initer + t = rhs_hess(it) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + t * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_y(i, j, iblk) + t * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + + ! Call preconditioner + call precondition(zetaD , & + Cb , vrel , & + umassdti , & + workspace_x , workspace_y, & + diagx , diagy , & + precond_type, & + workspace_x , workspace_y) + + solx = solx + workspace_x + soly = soly + workspace_y + + ! Increment outer loop counter and check for convergence + outiter = outiter + 1 + if (norm_residual <= relative_tolerance .or. outiter >= maxouter) then + return + end if + + ! Solution is not convergent : compute residual vector and continue. + + ! The residual vector is computed here using (see Saad p. 177) : + ! \begin{equation} + ! r = V_{m+1} * Q_m^T * (\gamma_{m+1} * e_{m+1}) + ! \end{equation} + ! where : + ! $r$ is the residual + ! $V_{m+1}$ is a matrix whose columns are the Arnoldi vectors from 1 to nextit (m+1) + ! $Q_m$ is the product of the Givens rotation : Q_m = G_m G_{m-1} ... G_1 + ! $gamma_{m+1}$ is the last element of rhs_hess + ! $e_{m+1})$ is the unit vector (0, 0, ..., 1)^T \in \reals^{m+1} + + ! Apply the Givens rotation in reverse order to g := \gamma_{m+1} * e_{m+1}, + ! store the result in rhs_hess + do it = 1, initer + jj = nextit - it + 1 + rhs_hess(jj-1) = -rot_sin(jj-1) * rhs_hess(jj) ! + rot_cos(jj-1) * g(jj-1) (== 0) + rhs_hess(jj) = rot_cos(jj-1) * rhs_hess(jj) ! + rot_sin(jj-1) * g(jj-1) (== 0) + end do + + ! Compute the residual by multiplying V_{m+1} and rhs_hess + workspace_x = c0 + workspace_y = c0 + do it = 1, nextit + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + workspace_x(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_x(i, j, iblk, it) + workspace_y(i, j, iblk) = workspace_x(i, j, iblk) + rhs_hess(it) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + arnoldi_basis_x(:,:,:,1) = workspace_x + arnoldi_basis_y(:,:,:,1) = workspace_y + end do + end do ! end of outer (restarts) loop + + end subroutine pgmres + +!======================================================================= + +! Generic routine to precondition a vector +! +! authors: Philippe Blain, ECCC + + subroutine precondition(zetaD , & + Cb , vrel , & + umassdti , & + vx , vy , & + diagx , diagy, & + precond_type, & + wx , wy) + + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks,4), intent(in) :: & + zetaD ! zetaD = 2*zeta (viscous coefficient) + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks), intent(in) :: & + vrel , & ! coefficient for tauw + Cb , & ! seabed stress coefficient + umassdti ! mass of U-cell/dte (kg/m^2 s) + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + vx , & ! input vector (x components) + vy ! input vector (y components) + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(in) :: & + diagx , & ! diagonal of the system matrix (x components) + diagy ! diagonal of the system matrix (y components) + + character (len=char_len), intent(in) :: & + precond_type ! type of preconditioner + + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks), intent(inout) :: & + wx , & ! preconditionned vector (x components) + wy ! preconditionned vector (y components) + + ! local variables + + integer (kind=int_kind) :: & + iblk , & ! block index + ij , & ! compressed index + i, j ! grid indices + + real (kind=dbl_kind) :: & + tolerance ! Tolerance for PGMRES + + integer (kind=int_kind) :: & + maxinner ! Restart parameter for PGMRES + + integer (kind=int_kind) :: & + maxouter ! Maximum number of outer iterations for PGMRES + + integer (kind=int_kind) :: & + nbiter ! Total number of iteration PGMRES performed + + character(len=*), parameter :: subname = '(precondition)' + + if (precond_type == 'ident') then ! identity (no preconditioner) + wx = vx + wy = vy + elseif (precond_type == 'diag') then ! Jacobi preconditioner (diagonal) + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + wx(i,j,iblk) = vx(i,j,iblk) / diagx(i,j,iblk) + wy(i,j,iblk) = vy(i,j,iblk) / diagy(i,j,iblk) + enddo ! ij + enddo + !$OMP END PARALLEL DO + elseif (precond_type == 'pgmres') then ! PGMRES (Jacobi-preconditioned GMRES) + ! Initialize preconditioned vector to 0 ! TODO: try with wx = vx or vx/diagx + wx = c0 + wy = c0 + tolerance = reltol_pgmres + maxinner = dim_pgmres + maxouter = maxits_pgmres + call pgmres (zetaD, & + Cb , vrel , & + umassdti , & + vx , vy , & + diagx , diagy , & + tolerance, maxinner, & + maxouter , & + wx , wy , & + nbiter) + else + call abort_ice(error_message='wrong preconditioner in ' // subname, & + file=__FILE__, line=__LINE__) + endif + end subroutine precondition + +!======================================================================= + +! Generic routine to orthogonalize a vector (arnoldi_basis_[xy](:, :, :, nextit)) +! against a set of vectors (arnoldi_basis_[xy](:, :, :, 1:initer)) +! +! authors: Philippe Blain, ECCC + + subroutine orthogonalize(ortho_type , initer , & + nextit , maxinner , & + arnoldi_basis_x, arnoldi_basis_y, & + hessenberg) + + character(len=*), intent(in) :: & + ortho_type ! type of orthogonalization + + integer (kind=int_kind), intent(in) :: & + initer , & ! inner (Arnoldi) loop counter + nextit , & ! nextit == initer+1 + maxinner ! Restart the method every maxinner inner iterations + + real (kind=dbl_kind), dimension(nx_block, ny_block, max_blocks, maxinner+1), intent(inout) :: & + arnoldi_basis_x , & ! arnoldi basis (x components) + arnoldi_basis_y ! arnoldi basis (y components) + + real (kind=dbl_kind), dimension(maxinner+1, maxinner), intent(inout) :: & + hessenberg ! system matrix of the Hessenberg (least squares) system + + ! local variables + + integer (kind=int_kind) :: & + it , & ! reusable loop counter + iblk , & ! block index + ij , & ! compressed index + i, j ! grid indices + + real (kind=dbl_kind), dimension (max_blocks) :: & + local_dot ! local array value to accumulate dot product of grid function over blocks + + real (kind=dbl_kind), dimension(maxinner) :: & + dotprod_local ! local array to accumulate several dot product computations + + character(len=*), parameter :: subname = '(orthogonalize)' + + if (trim(ortho_type) == 'cgs') then ! Classical Gram-Schmidt + ! Classical Gram-Schmidt orthogonalisation process + ! First loop of Gram-Schmidt (compute coefficients) + dotprod_local = c0 + do it = 1, initer + local_dot = c0 + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + local_dot(iblk) = local_dot(iblk) + & + (arnoldi_basis_x(i, j, iblk, it) * arnoldi_basis_x(i, j, iblk, nextit)) + & + (arnoldi_basis_y(i, j, iblk, it) * arnoldi_basis_y(i, j, iblk, nextit)) + enddo ! ij + enddo + !$OMP END PARALLEL DO + + dotprod_local(it) = sum(local_dot) + end do + + hessenberg(1:initer, initer) = global_allreduce_sum(dotprod_local(1:initer), distrb_info) + + ! Second loop of Gram-Schmidt (orthonormalize) + do it = 1, initer + !$OMP PARALLEL DO PRIVATE(iblk) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_x(i, j, iblk, it) + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + elseif (trim(ortho_type) == 'mgs') then ! Modified Gram-Schmidt + ! Modified Gram-Schmidt orthogonalisation process + do it = 1, initer + local_dot = c0 + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + local_dot(iblk) = local_dot(iblk) + & + (arnoldi_basis_x(i, j, iblk, it) * arnoldi_basis_x(i, j, iblk, nextit)) + & + (arnoldi_basis_y(i, j, iblk, it) * arnoldi_basis_y(i, j, iblk, nextit)) + enddo ! ij + enddo + !$OMP END PARALLEL DO + + hessenberg(it,initer) = global_sum(sum(local_dot), distrb_info) + + !$OMP PARALLEL DO PRIVATE(iblk, ij, i, j) + do iblk = 1, nblocks + do ij = 1, icellu(iblk) + i = indxui(ij, iblk) + j = indxuj(ij, iblk) + + arnoldi_basis_x(i, j, iblk, nextit) = arnoldi_basis_x(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_x(i, j, iblk, it) + arnoldi_basis_y(i, j, iblk, nextit) = arnoldi_basis_y(i, j, iblk, nextit) & + - hessenberg(it,initer) * arnoldi_basis_y(i, j, iblk, it) + enddo ! ij + enddo + !$OMP END PARALLEL DO + end do + else + call abort_ice(error_message='wrong orthonalization in ' // subname, & + file=__FILE__, line=__LINE__) + endif + + end subroutine orthogonalize + +!======================================================================= + +! Check if value A is close to zero, up to machine precision +! +!author +! Stéphane Gaudreault, ECCC -- June 2014 +! +!revision +! v4-80 - Gaudreault S. - gfortran compatibility +! 2019 - Philippe Blain, ECCC - converted to CICE standards + + logical function almost_zero(A) result(retval) + + real (kind=dbl_kind), intent(in) :: A + + ! local variables + + character(len=*), parameter :: subname = '(almost_zero)' + + integer (kind=int8_kind) :: aBit + integer (kind=int8_kind), parameter :: two_complement = int(Z'80000000', kind=int8_kind) + aBit = 0 + aBit = transfer(A, aBit) + if (aBit < 0) then + aBit = two_complement - aBit + end if + ! lexicographic order test with a tolerance of 1 adjacent float + retval = (abs(aBit) <= 1) + + end function almost_zero + +!======================================================================= + + end module ice_dyn_vp + +!======================================================================= diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 index 4c88037ed..43cf92a48 100755 --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -5059,23 +5059,31 @@ end subroutine ocn_data_ispol_init subroutine box2001_data ! wind and current fields as in Hunke, JCP 2001 +! these are defined at the u point ! authors: Elizabeth Hunke, LANL use ice_domain, only: nblocks + use ice_domain_size, only: max_blocks use ice_blocks, only: nx_block, ny_block, nghost use ice_flux, only: uocn, vocn, uatm, vatm, wind, rhoa, strax, stray - use ice_grid, only: uvm + use ice_grid, only: uvm, to_ugrid + use ice_state, only: aice ! local parameters integer (kind=int_kind) :: & iblk, i,j ! loop indices + real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) :: & + aiu ! ice fraction on u-grid + real (kind=dbl_kind) :: & secday, pi , puny, period, pi2, tau call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny) call icepack_query_parameters(secday_out=secday) + call to_ugrid(aice, aiu) + period = c4*secday do iblk = 1, nblocks @@ -5106,8 +5114,8 @@ subroutine box2001_data ! wind stress wind(i,j,iblk) = sqrt(uatm(i,j,iblk)**2 + vatm(i,j,iblk)**2) tau = rhoa(i,j,iblk) * 0.0012_dbl_kind * wind(i,j,iblk) - strax(i,j,iblk) = tau * uatm(i,j,iblk) - stray(i,j,iblk) = tau * vatm(i,j,iblk) + strax(i,j,iblk) = aiu(i,j,iblk) * tau * uatm(i,j,iblk) + stray(i,j,iblk) = aiu(i,j,iblk) * tau * vatm(i,j,iblk) ! initialization test ! Diagonal wind vectors 1 diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index f2eaae17d..fb9c45978 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -100,6 +100,11 @@ subroutine input_data basalstress, k1, k2, alphab, threshold_hw, & Ktens, e_ratio, coriolis, ssh_stress, & kridge, ktransport, brlx, arlx + use ice_dyn_vp, only: maxits_nonlin, precond, dim_fgmres, dim_pgmres, maxits_fgmres, & + maxits_pgmres, monitor_nonlin, monitor_fgmres, & + monitor_pgmres, reltol_nonlin, reltol_fgmres, reltol_pgmres, & + algo_nonlin, fpfunc_andacc, dim_andacc, reltol_andacc, & + damping_andacc, start_andacc, use_mean_vrel, ortho_type use ice_transport_driver, only: advection, conserv_check use ice_restoring, only: restore_ice #ifdef CESMCOUPLED @@ -194,7 +199,13 @@ subroutine input_data advection, coriolis, kridge, ktransport, & kstrength, krdg_partic, krdg_redist, mu_rdg, & e_ratio, Ktens, Cf, basalstress, & - k1, k2, alphab, threshold_hw, & + k1, maxits_nonlin, precond, dim_fgmres, & + dim_pgmres, maxits_fgmres, maxits_pgmres, monitor_nonlin, & + monitor_fgmres, monitor_pgmres, reltol_nonlin, reltol_fgmres, & + reltol_pgmres, algo_nonlin, dim_andacc, reltol_andacc, & + damping_andacc, start_andacc, fpfunc_andacc, use_mean_vrel, & + ortho_type, & + k2, alphab, threshold_hw, & Pstar, Cstar namelist /shortwave_nml/ & @@ -322,7 +333,27 @@ subroutine input_data alphab = 20.0_dbl_kind ! alphab=Cb factor in Lemieux et al 2015 threshold_hw = 30.0_dbl_kind ! max water depth for grounding Ktens = 0.0_dbl_kind ! T=Ktens*P (tensile strength: see Konig and Holland, 2010) - e_ratio = 2.0_dbl_kind ! EVP ellipse aspect ratio + e_ratio = 2.0_dbl_kind ! VP ellipse aspect ratio + maxits_nonlin = 4 ! max nb of iteration for nonlinear solver + precond = 'pgmres' ! preconditioner for fgmres: 'ident' (identity), 'diag' (diagonal), 'pgmres' (Jacobi-preconditioned GMRES) + dim_fgmres = 50 ! size of fgmres Krylov subspace + dim_pgmres = 5 ! size of pgmres Krylov subspace + maxits_fgmres = 50 ! max nb of iteration for fgmres + maxits_pgmres = 5 ! max nb of iteration for pgmres + monitor_nonlin = .false. ! print nonlinear residual norm + monitor_fgmres = .false. ! print fgmres residual norm + monitor_pgmres = .false. ! print pgmres residual norm + ortho_type = 'mgs' ! orthogonalization procedure 'cgs' or 'mgs' + reltol_nonlin = 1e-8_dbl_kind ! nonlinear stopping criterion: reltol_nonlin*res(k=0) + reltol_fgmres = 1e-2_dbl_kind ! fgmres stopping criterion: reltol_fgmres*res(k) + reltol_pgmres = 1e-6_dbl_kind ! pgmres stopping criterion: reltol_pgmres*res(k) + algo_nonlin = 'picard' ! nonlinear algorithm: 'picard' (Picard iteration), 'anderson' (Anderson acceleration) + fpfunc_andacc = 1 ! fixed point function for Anderson acceleration: 1: g(x) = FMGRES(A(x),b(x)), 2: g(x) = x - A(x)x + b(x) + dim_andacc = 5 ! size of Anderson minimization matrix (number of saved previous residuals) + reltol_andacc = 1e-6_dbl_kind ! relative tolerance for Anderson acceleration + damping_andacc = 0 ! damping factor for Anderson acceleration + start_andacc = 0 ! acceleration delay factor (acceleration starts at this iteration) + use_mean_vrel = .true. ! use mean of previous 2 iterates to compute vrel advection = 'remap' ! incremental remapping transport scheme conserv_check = .false.! tracer conservation check shortwave = 'ccsm3' ! 'ccsm3' or 'dEdd' (delta-Eddington) @@ -628,6 +659,26 @@ subroutine input_data call broadcast_scalar(ssh_stress, master_task) call broadcast_scalar(kridge, master_task) call broadcast_scalar(ktransport, master_task) + call broadcast_scalar(maxits_nonlin, master_task) + call broadcast_scalar(precond, master_task) + call broadcast_scalar(dim_fgmres, master_task) + call broadcast_scalar(dim_pgmres, master_task) + call broadcast_scalar(maxits_fgmres, master_task) + call broadcast_scalar(maxits_pgmres, master_task) + call broadcast_scalar(monitor_nonlin, master_task) + call broadcast_scalar(monitor_fgmres, master_task) + call broadcast_scalar(monitor_pgmres, master_task) + call broadcast_scalar(ortho_type, master_task) + call broadcast_scalar(reltol_nonlin, master_task) + call broadcast_scalar(reltol_fgmres, master_task) + call broadcast_scalar(reltol_pgmres, master_task) + call broadcast_scalar(algo_nonlin, master_task) + call broadcast_scalar(fpfunc_andacc, master_task) + call broadcast_scalar(dim_andacc, master_task) + call broadcast_scalar(reltol_andacc, master_task) + call broadcast_scalar(damping_andacc, master_task) + call broadcast_scalar(start_andacc, master_task) + call broadcast_scalar(use_mean_vrel, master_task) call broadcast_scalar(conduct, master_task) call broadcast_scalar(R_ice, master_task) call broadcast_scalar(R_pnd, master_task) @@ -831,7 +882,7 @@ subroutine input_data revised_evp = .false. endif - if (kdyn > 2) then + if (kdyn > 3) then if (my_task == master_task) then write(nu_diag,*) subname//' WARNING: kdyn out of range' endif @@ -1037,6 +1088,38 @@ subroutine input_data endif endif + ! Implicit solver input validation + if (kdyn == 3) then + if (.not. (trim(algo_nonlin) == 'picard' .or. trim(algo_nonlin) == 'anderson')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown algo_nonlin: '//algo_nonlin + write(nu_diag,*) subname//' ERROR: allowed values: ''picard'', ''anderson''' + endif + abort_list = trim(abort_list)//":60" + endif + + if (trim(algo_nonlin) == 'picard') then + ! Picard solver is implemented in the Anderson solver; reset number of saved residuals to zero + dim_andacc = 0 + endif + + if (.not. (trim(precond) == 'ident' .or. trim(precond) == 'diag' .or. trim(precond) == 'pgmres')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown precond: '//precond + write(nu_diag,*) subname//' ERROR: allowed values: ''ident'', ''diag'', ''pgmres''' + endif + abort_list = trim(abort_list)//":61" + endif + + if (.not. (trim(ortho_type) == 'cgs' .or. trim(ortho_type) == 'mgs')) then + if (my_task == master_task) then + write(nu_diag,*) subname//' ERROR: unknown ortho_type: '//ortho_type + write(nu_diag,*) subname//' ERROR: allowed values: ''cgs'', ''mgs''' + endif + abort_list = trim(abort_list)//":62" + endif + endif + ice_IOUnitsMinUnit = numin ice_IOUnitsMaxUnit = numax @@ -1139,28 +1222,35 @@ subroutine input_data write(nu_diag,*) '--------------------------------' if (kdyn == 1) then tmpstr2 = ' elastic-viscous-plastic dynamics' - write(nu_diag,*) 'yield_curve = ', trim(yield_curve) - if (trim(yield_curve) == 'ellipse') & - write(nu_diag,1007) ' e_ratio = ', e_ratio, ' aspect ratio of ellipse' elseif (kdyn == 2) then tmpstr2 = ' elastic-anisotropic-plastic dynamics' + elseif (kdyn == 3) then + tmpstr2 = ' viscous-plastic dynamics' elseif (kdyn < 1) then tmpstr2 = ' dynamics disabled' endif write(nu_diag,1022) ' kdyn = ', kdyn,trim(tmpstr2) if (kdyn >= 1) then - if (revised_evp) then - tmpstr2 = ' revised EVP formulation used' - else - tmpstr2 = ' revised EVP formulation not used' - endif - write(nu_diag,1012) ' revised_evp = ', revised_evp,trim(tmpstr2) - write(nu_diag,1022) ' kevp_kernel = ', kevp_kernel,' EVP solver' + if (kdyn == 1 .or. kdyn == 2) then + if (revised_evp) then + tmpstr2 = ' revised EVP formulation used' + write(nu_diag,1007) ' arlx = ', arlx, ' stress equation factor alpha' + write(nu_diag,1007) ' brlx = ', brlx, ' stress equation factor beta' + else + tmpstr2 = ' revised EVP formulation not used' + endif + write(nu_diag,1012) ' revised_evp = ', revised_evp,trim(tmpstr2) + write(nu_diag,1022) ' kevp_kernel = ', kevp_kernel,' EVP solver' + + write(nu_diag,1022) ' ndtd = ', ndtd, ' number of dynamics/advection/ridging/steps per thermo timestep' + write(nu_diag,1022) ' ndte = ', ndte, ' number of EVP or EAP subcycles' + endif - write(nu_diag,1022) ' ndtd = ', ndtd, ' number of dynamics/advection/ridging/steps per thermo timestep' - write(nu_diag,1022) ' ndte = ', ndte, ' number of EVP or EAP subcycles' - write(nu_diag,1007) ' arlx = ', arlx, ' stress equation factor alpha' - write(nu_diag,1007) ' brlx = ', brlx, ' stress equation factor beta' + if (kdyn == 1 .or. kdyn == 3) then + write(nu_diag,*) 'yield_curve = ', trim(yield_curve) + if (trim(yield_curve) == 'ellipse') & + write(nu_diag,1007) ' e_ratio = ', e_ratio, ' aspect ratio of ellipse' + endif if (trim(coriolis) == 'latitude') then tmpstr2 = ': latitude-dependent Coriolis parameter' @@ -1524,6 +1614,31 @@ subroutine input_data write(nu_diag,1010) ' orca_halogrid = ', & orca_halogrid + if (kdyn == 3) then + write(nu_diag,1020) ' maxits_nonlin = ', maxits_nonlin + write(nu_diag,1030) ' precond = ', precond + write(nu_diag,1020) ' dim_fgmres = ', dim_fgmres + write(nu_diag,1020) ' dim_pgmres = ', dim_pgmres + write(nu_diag,1020) ' maxits_fgmres = ', maxits_fgmres + write(nu_diag,1020) ' maxits_pgmres = ', maxits_pgmres + write(nu_diag,1010) ' monitor_nonlin = ', monitor_nonlin + write(nu_diag,1010) ' monitor_fgmres = ', monitor_fgmres + write(nu_diag,1010) ' monitor_pgmres = ', monitor_pgmres + write(nu_diag,1030) ' ortho_type = ', ortho_type + write(nu_diag,1008) ' reltol_nonlin = ', reltol_nonlin + write(nu_diag,1008) ' reltol_fgmres = ', reltol_fgmres + write(nu_diag,1008) ' reltol_pgmres = ', reltol_pgmres + write(nu_diag,1030) ' algo_nonlin = ', algo_nonlin + write(nu_diag,1010) ' use_mean_vrel = ', use_mean_vrel + if (algo_nonlin == 'anderson') then + write(nu_diag,1020) ' fpfunc_andacc = ', fpfunc_andacc + write(nu_diag,1020) ' dim_andacc = ', dim_andacc + write(nu_diag,1008) ' reltol_andacc = ', reltol_andacc + write(nu_diag,1005) ' damping_andacc = ', damping_andacc + write(nu_diag,1020) ' start_andacc = ', start_andacc + endif + endif + write(nu_diag,1010) ' conserv_check = ', conserv_check write(nu_diag,1020) ' fyear_init = ', & @@ -1675,6 +1790,7 @@ subroutine input_data 1005 format (a30,2x,f12.6) ! float 1006 format (a20,2x,f10.6,a) 1007 format (a20,2x,f6.2,a) + 1008 format (a30,2x,d13.6) ! float, exponential notation 1009 format (a20,2x,d13.6,a) ! float, exponential notation 1010 format (a30,2x,l6) ! logical 1012 format (a20,2x,l3,1x,a) ! logical diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 77d0ad492..4b92c2a42 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -850,6 +850,7 @@ subroutine step_dyn_horiz (dt) use ice_dyn_evp, only: evp use ice_dyn_eap, only: eap + use ice_dyn_vp, only: implicit_solver use ice_dyn_shared, only: kdyn, ktransport use ice_flux, only: init_history_dyn !deprecate upwind use ice_transport_driver, only: advection, transport_upwind, transport_remap @@ -863,11 +864,12 @@ subroutine step_dyn_horiz (dt) call init_history_dyn ! initialize dynamic history variables !----------------------------------------------------------------- - ! Elastic-viscous-plastic ice dynamics + ! Ice dynamics (momentum equation) !----------------------------------------------------------------- if (kdyn == 1) call evp (dt) if (kdyn == 2) call eap (dt) + if (kdyn == 3) call implicit_solver (dt) !----------------------------------------------------------------- ! Horizontal ice transport diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_global_reductions.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_global_reductions.F90 index 2b4172d81..1d724fb39 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_global_reductions.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_global_reductions.F90 @@ -22,7 +22,7 @@ module ice_global_reductions #else use ice_communicate, only: my_task, mpiR16, mpiR8, mpiR4, master_task #endif - use ice_constants, only: field_loc_Nface, field_loc_NEcorner + use ice_constants, only: field_loc_Nface, field_loc_NEcorner, c0 use ice_fileunits, only: bfbflag use ice_exit, only: abort_ice use ice_distribution, only: distrb, ice_distributionGet, & @@ -36,6 +36,7 @@ module ice_global_reductions private public :: global_sum, & + global_allreduce_sum, & global_sum_prod, & global_maxval, & global_minval @@ -55,6 +56,12 @@ module ice_global_reductions global_sum_scalar_int end interface + interface global_allreduce_sum + module procedure global_allreduce_sum_vector_dbl!, & + ! module procedure global_allreduce_sum_vector_real, & ! not yet implemented + ! module procedure global_allreduce_sum_vector_int ! not yet implemented + end interface + interface global_sum_prod module procedure global_sum_prod_dbl, & global_sum_prod_real, & @@ -700,6 +707,69 @@ function global_sum_scalar_int(scalar, dist) & end function global_sum_scalar_int +!*********************************************************************** + + function global_allreduce_sum_vector_dbl(vector, dist) & + result(globalSums) + +! Computes the global sums of sets of scalars (elements of 'vector') +! distributed across a parallel machine. +! +! This is actually the specific interface for the generic global_allreduce_sum +! function corresponding to double precision vectors. The generic +! interface is identical but will handle real and integer vectors. + + real (dbl_kind), dimension(:), intent(in) :: & + vector ! vector whose components are to be summed + + type (distrb), intent(in) :: & + dist ! block distribution + + real (dbl_kind), dimension(size(vector)) :: & + globalSums ! resulting array of global sums + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ierr, &! mpi error flag + numProcs, &! number of processor participating + numBlocks, &! number of local blocks + communicator, &! communicator for this distribution + numElem ! number of elements in vector + + real (dbl_kind), dimension(:,:), allocatable :: & + work ! temporary local array + + character(len=*), parameter :: subname = '(global_allreduce_sum_vector_dbl)' + +!----------------------------------------------------------------------- +! +! get communicator for MPI calls +! +!----------------------------------------------------------------------- + + call ice_distributionGet(dist, & + numLocalBlocks = numBlocks, & + nprocs = numProcs, & + communicator = communicator) + + numElem = size(vector) + allocate(work(1,numElem)) + work(1,:) = vector + globalSums = c0 + + call compute_sums_dbl(work,globalSums,communicator,numProcs) + + deallocate(work) + +!----------------------------------------------------------------------- + + end function global_allreduce_sum_vector_dbl + !*********************************************************************** function global_sum_prod_dbl (array1, array2, dist, field_loc, & diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_global_reductions.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_global_reductions.F90 index 1517bd73b..4d53e873e 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_global_reductions.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_global_reductions.F90 @@ -23,7 +23,7 @@ module ice_global_reductions #else use ice_communicate, only: my_task, mpiR16, mpiR8, mpiR4, master_task #endif - use ice_constants, only: field_loc_Nface, field_loc_NEcorner + use ice_constants, only: field_loc_Nface, field_loc_NEcorner, c0 use ice_fileunits, only: bfbflag use ice_exit, only: abort_ice use ice_distribution, only: distrb, ice_distributionGet, & @@ -37,6 +37,7 @@ module ice_global_reductions private public :: global_sum, & + global_allreduce_sum, & global_sum_prod, & global_maxval, & global_minval @@ -56,6 +57,12 @@ module ice_global_reductions global_sum_scalar_int end interface + interface global_allreduce_sum + module procedure global_allreduce_sum_vector_dbl!, & + ! module procedure global_allreduce_sum_vector_real, & ! not yet implemented + ! module procedure global_allreduce_sum_vector_int ! not yet implemented + end interface + interface global_sum_prod module procedure global_sum_prod_dbl, & global_sum_prod_real, & @@ -701,6 +708,69 @@ function global_sum_scalar_int(scalar, dist) & end function global_sum_scalar_int +!*********************************************************************** + + function global_allreduce_sum_vector_dbl(vector, dist) & + result(globalSums) + +! Computes the global sums of sets of scalars (elements of 'vector') +! distributed across a parallel machine. +! +! This is actually the specific interface for the generic global_allreduce_sum +! function corresponding to double precision vectors. The generic +! interface is identical but will handle real and integer vectors. + + real (dbl_kind), dimension(:), intent(in) :: & + vector ! vector whose components are to be summed + + type (distrb), intent(in) :: & + dist ! block distribution + + real (dbl_kind), dimension(size(vector)) :: & + globalSums ! resulting array of global sums + +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + integer (int_kind) :: & + ierr, &! mpi error flag + numProcs, &! number of processor participating + numBlocks, &! number of local blocks + communicator, &! communicator for this distribution + numElem ! number of elements in vector + + real (dbl_kind), dimension(:,:), allocatable :: & + work ! temporary local array + + character(len=*), parameter :: subname = '(global_allreduce_sum_vector_dbl)' + +!----------------------------------------------------------------------- +! +! get communicator for MPI calls +! +!----------------------------------------------------------------------- + + call ice_distributionGet(dist, & + numLocalBlocks = numBlocks, & + nprocs = numProcs, & + communicator = communicator) + + numElem = size(vector) + allocate(work(1,numElem)) + work(1,:) = vector + globalSums = c0 + + call compute_sums_dbl(work,globalSums,communicator,numProcs) + + deallocate(work) + +!----------------------------------------------------------------------- + + end function global_allreduce_sum_vector_dbl + !*********************************************************************** function global_sum_prod_dbl (array1, array2, dist, field_loc, & diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 34b37cf29..67129c911 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -340,6 +340,7 @@ subroutine init_grid2 real (kind=dbl_kind) :: & angle_0, angle_w, angle_s, angle_sw, & pi, pi2, puny + logical (kind=log_kind), dimension(nx_block,ny_block,max_blocks):: & out_of_range diff --git a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 index dc41ff9fd..49cf12ce1 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, basalstress, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, basalstress, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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, & @@ -120,11 +121,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 index e43b4a24d..e8c809d9e 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_RunMod.F90 @@ -353,6 +353,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyt, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & fsurfn_f, flatn_f, scale_fluxes, frzmlt_init, frzmlt @@ -528,6 +529,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index 80bb2570e..da745d965 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init(mpicom_ice) use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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, & @@ -122,11 +123,12 @@ subroutine cice_init(mpicom_ice) call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index ee217712b..d53014b7b 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -367,6 +367,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt, Uref, wind @@ -565,6 +566,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index 917774908..b37d73f65 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -52,7 +52,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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 @@ -98,11 +99,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler @@ -161,8 +163,8 @@ subroutine cice_init call faero_optics !initialize aerosol optical property tables end if - ! Initialize shortwave components using swdn from previous timestep - ! if restarting. These components will be scaled to current forcing + ! Initialize shortwave components using swdn from previous timestep + ! if restarting. These components will be scaled to current forcing ! in prep_radiation. if (trim(runtype) == 'continue' .or. restart) then @@ -249,7 +251,7 @@ subroutine init_restart if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - if (trim(runtype) == 'continue') then + if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in call calendar(time) ! update time parameters @@ -260,17 +262,17 @@ subroutine init_restart ! call restartfile_v4 (ice_ic) ! CICE v4.1 binary restart file !!! uncomment if EAP restart data exists ! if (kdyn == 2) call read_restart_eap - endif + endif ! tracers - ! ice age tracer - if (tr_iage) then + ! ice age tracer + if (tr_iage) then if (trim(runtype) == 'continue') & restart_age = .true. if (restart_age) then call read_restart_age else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_age(trcrn(:,:,nt_iage,:,iblk)) enddo ! iblk endif @@ -281,7 +283,7 @@ subroutine init_restart if (restart_FY) then call read_restart_FY else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_FY(trcrn(:,:,nt_FY,:,iblk)) enddo ! iblk endif @@ -292,7 +294,7 @@ subroutine init_restart if (restart_lvl) then call read_restart_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_lvl(iblk,trcrn(:,:,nt_alvl,:,iblk), & trcrn(:,:,nt_vlvl,:,iblk)) enddo ! iblk @@ -305,7 +307,7 @@ subroutine init_restart if (restart_pond_cesm) then call read_restart_pond_cesm else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_cesm(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk)) enddo ! iblk @@ -318,7 +320,7 @@ subroutine init_restart if (restart_pond_lvl) then call read_restart_pond_lvl else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_lvl(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk), & @@ -333,7 +335,7 @@ subroutine init_restart if (restart_pond_topo) then call read_restart_pond_topo else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_meltponds_topo(trcrn(:,:,nt_apnd,:,iblk), & trcrn(:,:,nt_hpnd,:,iblk), & trcrn(:,:,nt_ipnd,:,iblk)) @@ -356,7 +358,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 @@ -368,7 +370,7 @@ subroutine init_restart if (restart_aero) then call read_restart_aero else - do iblk = 1, nblocks + do iblk = 1, nblocks call init_aerosol(trcrn(:,:,nt_aero:nt_aero+4*n_aero-1,:,iblk)) enddo ! iblk endif ! .not. restart_aero diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index 4e236bb11..70ef5f895 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -76,7 +76,7 @@ subroutine cice_init(mpi_comm) use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared 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, & @@ -134,11 +134,12 @@ subroutine cice_init(mpi_comm) call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index ad575f714..df8fe4978 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -362,6 +362,7 @@ subroutine coupling_prep (iblk) alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -556,6 +557,10 @@ subroutine coupling_prep (iblk) Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 0a8614eb2..8b507740d 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -71,7 +71,8 @@ subroutine cice_init use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap - use ice_dyn_shared, only: kdyn, init_evp, alloc_dyn_shared + use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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, & @@ -122,11 +123,12 @@ subroutine cice_init call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then call alloc_dyn_eap ! allocate dyn_eap arrays - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index b45db2514..bd818211e 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -352,9 +352,8 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, & + fswthru_ai, fhocn, scale_factor, snowfrac, & fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & - scale_factor, snowfrac, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug index c7ae7601f..8f5de17ea 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug @@ -395,6 +395,7 @@ alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & + fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -589,6 +590,10 @@ Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & fhocn (:,:,iblk), fswthru (:,:,iblk), & + fswthru_vdr(:,:,iblk), & + fswthru_vdf(:,:,iblk), & + fswthru_idr(:,:,iblk), & + fswthru_idf(:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & diff --git a/cicecore/shared/ice_fileunits.F90 b/cicecore/shared/ice_fileunits.F90 index 4c91fdb2a..b6b30d47a 100644 --- a/cicecore/shared/ice_fileunits.F90 +++ b/cicecore/shared/ice_fileunits.F90 @@ -1,4 +1,3 @@ -! SVN:$Id: ice_fileunits.F90 1228 2017-05-23 21:33:34Z tcraig $ !======================================================================= ! ! This module contains an I/O unit manager for tracking, assigning diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index a26579df1..3139726f5 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -139,6 +139,21 @@ kridge = 1 ktransport = 1 ssh_stress = 'geostrophic' + maxits_nonlin = 4 + precond = 'pgmres' + dim_fgmres = 50 + dim_pgmres = 5 + maxits_fgmres = 1 + maxits_pgmres = 1 + monitor_nonlin = .false. + monitor_fgmres = .false. + monitor_pgmres = .false. + ortho_type = 'mgs' + reltol_nonlin = 1e-8 + reltol_fgmres = 1e-2 + reltol_pgmres = 1e-6 + algo_nonlin = 'picard' + use_mean_vrel = .true. / &shortwave_nml diff --git a/configuration/scripts/machines/Macros.banting_intel b/configuration/scripts/machines/Macros.banting_intel index 96b6933f0..7ed7f7b5a 100644 --- a/configuration/scripts/machines/Macros.banting_intel +++ b/configuration/scripts/machines/Macros.banting_intel @@ -9,7 +9,7 @@ CFLAGS := -c -O2 -fp-model precise #-xHost FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/Macros.cesium_intel b/configuration/scripts/machines/Macros.cesium_intel index 1bca1ddac..2ad3ff1f3 100644 --- a/configuration/scripts/machines/Macros.cesium_intel +++ b/configuration/scripts/machines/Macros.cesium_intel @@ -11,7 +11,7 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost FFLAGS_NOOPT:= -O0 @@ -50,7 +50,7 @@ LIB_PNETCDF := $(PNETCDF_PATH)/lib LIB_MPI := $(IMPILIBDIR) #SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf -lgptl -SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf +SLIBS := -L$(LIB_NETCDF) -lnetcdff -lnetcdf -llapack -lblas ifeq ($(ICE_THREADED), true) LDFLAGS += -openmp diff --git a/configuration/scripts/machines/Macros.conda_linux b/configuration/scripts/machines/Macros.conda_linux index 32c5ae012..c821a4592 100644 --- a/configuration/scripts/machines/Macros.conda_linux +++ b/configuration/scripts/machines/Macros.conda_linux @@ -40,7 +40,7 @@ LD:= $(FC) MODDIR += -I$(CONDA_PREFIX)/include # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 0d866d9a2..4acc4d3ba 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -48,7 +48,7 @@ else endif # Libraries to be passed to the linker -SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff -llapack # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) diff --git a/configuration/scripts/machines/Macros.daley_intel b/configuration/scripts/machines/Macros.daley_intel index 373c9cc42..897e6e057 100644 --- a/configuration/scripts/machines/Macros.daley_intel +++ b/configuration/scripts/machines/Macros.daley_intel @@ -9,7 +9,7 @@ CFLAGS := -c -O2 -fp-model precise #-xHost FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/Macros.fram_intel b/configuration/scripts/machines/Macros.fram_intel index 5804b1475..11faa612d 100644 --- a/configuration/scripts/machines/Macros.fram_intel +++ b/configuration/scripts/machines/Macros.fram_intel @@ -11,7 +11,7 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -O2 -fp-model precise -convert big_endian -assume byterecl -ftz -traceback +FFLAGS := -O2 -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost FFLAGS_NOOPT:= -O0 diff --git a/configuration/scripts/machines/Macros.millikan_intel b/configuration/scripts/machines/Macros.millikan_intel index 9b86e442b..4a3b21093 100644 --- a/configuration/scripts/machines/Macros.millikan_intel +++ b/configuration/scripts/machines/Macros.millikan_intel @@ -11,7 +11,7 @@ CFLAGS := -c -O2 -fp-model precise FIXEDFLAGS := -132 FREEFLAGS := -FR -FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback +FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceback -no-wrap-margin #-xHost FFLAGS_NOOPT:= -O0 diff --git a/configuration/scripts/machines/environment.yml b/configuration/scripts/machines/environment.yml index aab90d23c..57bdacfec 100644 --- a/configuration/scripts/machines/environment.yml +++ b/configuration/scripts/machines/environment.yml @@ -8,6 +8,7 @@ dependencies: - netcdf-fortran - openmpi - make + - liblapack # Python dependencies for plotting scripts - numpy - matplotlib-base diff --git a/configuration/scripts/options/set_env.lapack b/configuration/scripts/options/set_env.lapack new file mode 100644 index 000000000..cf52ad1b0 --- /dev/null +++ b/configuration/scripts/options/set_env.lapack @@ -0,0 +1 @@ +setenv ICE_CPPDEFS -DUSE_LAPACK diff --git a/configuration/scripts/options/set_nml.diagimp b/configuration/scripts/options/set_nml.diagimp new file mode 100644 index 000000000..940754157 --- /dev/null +++ b/configuration/scripts/options/set_nml.diagimp @@ -0,0 +1,3 @@ +monitor_nonlin = .true. +monitor_fgmres = .true. +monitor_pgmres = .true. diff --git a/configuration/scripts/options/set_nml.dynanderson b/configuration/scripts/options/set_nml.dynanderson new file mode 100644 index 000000000..566c53a09 --- /dev/null +++ b/configuration/scripts/options/set_nml.dynanderson @@ -0,0 +1,3 @@ +kdyn = 3 +algo_nonlin = 'anderson' +use_mean_vrel = .false. diff --git a/configuration/scripts/options/set_nml.dynpicard b/configuration/scripts/options/set_nml.dynpicard new file mode 100644 index 000000000..b81f4d4e6 --- /dev/null +++ b/configuration/scripts/options/set_nml.dynpicard @@ -0,0 +1,3 @@ +kdyn = 3 +algo_nonlin = 'picard' +use_mean_vrel = .true. diff --git a/configuration/scripts/options/set_nml.nonlin5000 b/configuration/scripts/options/set_nml.nonlin5000 new file mode 100644 index 000000000..f767a3d0d --- /dev/null +++ b/configuration/scripts/options/set_nml.nonlin5000 @@ -0,0 +1 @@ +maxits_nonlin = 5000 diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt new file mode 100644 index 000000000..102a19d80 --- /dev/null +++ b/configuration/scripts/options/set_nml.run3dt @@ -0,0 +1,6 @@ +npt = 3 +dump_last = .true. +histfreq = '1','x','x','x','x' +hist_avg = .false. +f_uvel = '1' +f_vvel = '1' diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index e96b07622..386c29e41 100755 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -50,3 +50,4 @@ restart gx3 4x4 iobinary restart gx3 4x4 histall,precision8,cdf64 smoke gx3 30x1 bgcz,histall smoke gx3 14x2 fsd12,histall +smoke gx3 4x1 dynpicard,medium diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 1fb73c2d7..8ea16261d 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -336,7 +336,7 @@ either Celsius or Kelvin units). "kalg", ":math:`\bullet` absorption coefficient for algae", "" "kappav", "visible extinction coefficient in ice, wavelength\ :math:`<`\ 700nm", "1.4 m\ :math:`^{-1}`" "kcatbound", ":math:`\bullet` category boundary formula", "" - "kdyn", ":math:`\bullet` type of dynamics (1 = EVP, 0 = off)", "1" + "kdyn", ":math:`\bullet` type of dynamics (1 = EVP, 2 = EAP, 3 = VP, 0,-1 = off)", "1" "kg_to_g", "kg to g conversion factor", "1000." "kice", "thermal conductivity of fresh ice (:cite:`Bitz99`)", "2.03 W/m/deg" "kitd", ":math:`\bullet` type of itd conversions (0 = delta function, 1 = linear remap)", "1" diff --git a/doc/source/developer_guide/dg_driver.rst b/doc/source/developer_guide/dg_driver.rst index dd560a17c..a10cb319a 100644 --- a/doc/source/developer_guide/dg_driver.rst +++ b/doc/source/developer_guide/dg_driver.rst @@ -55,10 +55,11 @@ The initialize calling sequence looks something like:: call init_zbgc ! vertical biogeochemistry initialization call init_calendar ! initialize some calendar stuff call init_hist (dt) ! initialize output history file + call init_dyn (dt_dyn) ! define dynamics parameters, variables if (kdyn == 2) then - call init_eap (dt_dyn) ! define eap dynamics parameters, variables - else ! for both kdyn = 0 or 1 - call init_evp (dt_dyn) ! define evp dynamics parameters, variables + call init_eap ! define eap dynamics parameters, variables + else if (kdyn == 3) then + call init_vp ! define vp dynamics parameters, variables endif call init_coupler_flux ! initialize fluxes exchanged with coupler call init_thermo_vertical ! initialize vertical thermodynamics diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index 3551763b5..eac19b1f6 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -30,13 +30,13 @@ Dynamical Solvers -------------------- The dynamics solvers are found in **cicecore/cicedynB/dynamics/**. A couple of different solvers are -available including EVP, revised EVP, and EAP. The dynamics solver is specified in namelist with the -``kdyn`` variable. ``kdyn=1`` is evp, ``kdyn=2`` is eap, and revised evp requires the ``revised_evp`` -namelist flag be set to true. +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 +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 +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 diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index caa93ec06..0b928d012 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -59,6 +59,8 @@ @string{GMD @string{CRST = {Cold Reg. Sci. Technol.}} @string{IJHPCA={Int. J High Perform. Comput. Appl}} @string{PTRSA={Philos. Trans. Royal Soc. A}} +@string{SIAMJCP={SIAM J. Sci. Comput.}} + % ********************************************** @@ -977,6 +979,31 @@ @Article{Tsujino18 pages = {79-139}, url = {http://dx.doi.org/10.1016/j.ocemod.2018.07.002} } +@Article{Lemieux08, + author = "J.-F. Lemieux and B. Tremblay and S. Thomas and J. Sedláček and L. A. Mysak", + title = "{Using the preconditioned Generalized Minimum RESidual (GMRES) method to solve the sea-ice momentum equation}", + journal = JGRO, + volume = {113}, + number = {C10}, + pages = {}, + keywords = {Sea ice, GMRES, Krylov subspace}, + doi = {10.1029/2007JC004680}, + url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2007JC004680}, + eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2007JC004680}, + year = {2008} +} +@Article{Saad93, + author = "Y. Saad", + title = "{A Flexible Inner-Outer Preconditioned GMRES Algorithm}", + journal = SIAMJCP, + volume = {14}, + number = {2}, + year = {1993}, + pages = {461-469}, + doi = {10.1137/0914028}, + URL = {https://doi.org/10.1137/0914028} +} + % ********************************************** % For new entries, see example entry in BIB_TEMPLATE.txt % ********************************************** diff --git a/doc/source/science_guide/sg_dynamics.rst b/doc/source/science_guide/sg_dynamics.rst index 4c9b6d502..e7f214ff7 100644 --- a/doc/source/science_guide/sg_dynamics.rst +++ b/doc/source/science_guide/sg_dynamics.rst @@ -5,15 +5,19 @@ Dynamics ======== -There are now different rheologies available in the CICE code. The +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, 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 rheology is used (module -**ice\_dyn\_evp.F90**), while `kdyn` = 2 is associated with the EAP -rheology (**ice\_dyn\_eap.F90**). At times scales associated with the +``kdyn`` = 1 in the namelist then the EVP model is used (module +**ice\_dyn\_evp.F90**), while ``kdyn`` = 2 is associated with the EAP +model (**ice\_dyn\_eap.F90**), and ``kdyn`` = 3 is associated with the +VP model (**ice\_dyn\_vp.F90**). + +At times scales associated with the wind forcing, the EVP model reduces to the VP model while the EAP model reduces to the anisotropic rheology described in detail in :cite:`Wilchinsky06,Tsamados13`. At shorter time scales the @@ -29,14 +33,23 @@ dynamics in :cite:`Tsamados13`. Simulation results and performance of the EVP and EAP models have been compared with the VP model and with each other in realistic simulations of the Arctic respectively in :cite:`Hunke99` and -:cite:`Tsamados13`. Here we summarize the equations and -direct the reader to the above references for details. The numerical +:cite:`Tsamados13`. + +The EVP numerical implementation in this code release is that of :cite:`Hunke02` and :cite:`Hunke03`, with revisions to the numerical solver as in :cite:`Bouillon13`. The implementation of the EAP sea ice dynamics into CICE is described in detail in :cite:`Tsamados13`. +The VP solver implementation mostly follows :cite:`Lemieux08`, with +FGMRES :cite:`Saad93` as the linear solver and GMRES as the preconditioner. +Note that the VP solver has not yet been tested on the ``tx1`` grid or with +threading enabled. + +Here we summarize the equations and +direct the reader to the above references for details. + .. _momentum: ******** @@ -67,20 +80,36 @@ concentration regions. A careful explanation of the issue and its continuum solution is provided in :cite:`Hunke03` and :cite:`Connolley04`. -The momentum equation is discretized in time as follows, for the classic -EVP approach. First, for clarity, the two components of Equation :eq:`vpmom` are +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} + :label: momsys + + +A bilinear discretization is used for the stress terms +:math:`\partial\sigma_{ij}/\partial x_j`, +which enables the discrete equations to be derived from the +continuous equations written in curvilinear coordinates. In this +manner, metric terms associated with the curvature of the grid are +incorporated into the discretization explicitly. Details pertaining to +the spatial discretization are found in :cite:`Hunke02`. + +.. _evp-momentum: + +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}`, @@ -91,20 +120,20 @@ 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(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} - + {\tt vrel}\underbrace{\left(U_w\cos\theta-V_w\sin\theta\right)}_{\tt waterx} + {m\over\Delta t_e}u^k, + = &\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_e}u^k, :label: umom .. math:: \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} - + {\tt vrel}\underbrace{\left(U_w\sin\theta+V_w\cos\theta\right)}_{\tt watery} + {m\over\Delta t_e}v^k, + = &\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_e}v^k, :label: vmom -and vrel\ :math:`\cdot`\ waterx(y) = taux(y). +and :math:`{\tt vrel}\ \cdot\ {\tt waterx(y)}= {\tt taux(y)}`. We solve this system of equations analytically for :math:`u^{k+1}` and :math:`v^{k+1}`. Define @@ -121,8 +150,8 @@ where :math:`{\bf F} = \nabla\cdot\sigma^{k+1}`. Then .. math:: \begin{aligned} - \left({m\over\Delta t_e} +{\tt vrel}\cos\theta\ + C_b \right)u^{k+1} - \left(mf + {\tt vrel}\sin\theta\right) v^{k+1} &=& \hat{u} \\ - \left(mf + {\tt vrel}\sin\theta\right) u^{k+1} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta + C_b \right)v^{k+1} &=& \hat{v}.\end{aligned} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta\ + C_b \right)u^{k+1} - \left(mf + {\tt vrel}\sin\theta\right) v^{k+1} &= \hat{u} \\ + \left(mf + {\tt vrel}\sin\theta\right) u^{k+1} + \left({m\over\Delta t_e} +{\tt vrel}\cos\theta + C_b \right)v^{k+1} &= \hat{v}.\end{aligned} Solving simultaneously for :math:`u^{k+1}` and :math:`v^{k+1}`, @@ -140,10 +169,62 @@ where .. math:: b = mf + {\tt vrel}\sin\theta. :label: cevpb + +.. _vp-momentum: + +Viscous-Plastic +~~~~~~~~~~~~~~~ + +In the VP approach, equation :eq:`momsys` is discretized implicitly using a Backward Euler approach, +and stresses are not computed explicitly: -When the subcycling is finished for each (thermodynamic) time step, the -ice–ocean stress must be constructed from `taux(y)` and the terms -containing `vrel` on the left hand side of the equations. +.. math:: + \begin{align} + m\frac{(u^{n}-u^{n-1})}{\Delta t} &= \frac{\partial \sigma_{1j}^n}{\partial x_j} + - \tau_{w,x}^n + \tau_{b,x}^n + mfv^n + + r_{x}^n, + \\ + m\frac{(v^{n}-v^{n-1})}{\Delta t} &= \frac{\partial \sigma^{n} _{2j}}{\partial x_j} + - \tau_{w,y}^n + \tau_{b,y}^n -mfu^{n} + + r_{y}^n + \end{align} + :label: u_sit + +where :math:`r = (r_x,r_y)` contains all terms that do not depend on the velocities :math:`u^n, v^n` (namely the sea surface tilt and the wind stress). +As the water drag, seabed stress and rheology term depend on the velocity field, the only unknowns in equation :eq:`u_sit` are :math:`u^n` and :math:`v^n`. + +Once discretized in space, equation :eq:`u_sit` leads to a system of :math:`N` nonlinear equations with :math:`N` unknowns that can be concisely written as + +.. math:: + \mathbf{A}(\mathbf{u})\mathbf{u} = \mathbf{b}(\mathbf{u}), + :label: nonlin_sys + +where :math:`\mathbf{A}` is an :math:`N\times N` matrix and :math:`\mathbf{u}` and :math:`\mathbf{b}` are vectors of size :math:`N`. +Note that we have dropped the time level index :math:`n`. +The vector :math:`\mathbf{u}` is formed by stacking first the :math:`u` components, followed by the :math:`v` components of the discretized ice velocity. +The vector :math:`\mathbf{b}` is a function of the velocity vector :math:`\mathbf{u}` because of the water and seabed stress terms as well as parts of the rheology term that depend non-linearly on :math:`\mathbf{u}`. + +The nonlinear system :eq:`nonlin_sys` is solved using a Picard iteration method. +Starting from a previous iterate :math:`\mathbf{u}_{k-1}`, the nonlinear system is linearized by substituting :math:`\mathbf{u}_{k-1}` in the expression of the matrix :math:`\mathbf{A}` and the vector :math:`\mathbf{b}`: + +.. math:: + \mathbf{A}(\mathbf{u}_{k-1})\mathbf{u}_{k} = \mathbf{b}(\mathbf{u}_{k-1}) + :label: picard + +The resulting linear system is solved using the Flexible Generalized Minimum RESidual (FGMRES, :cite:`Saad93`) method and this process is repeated iteratively. + +The maximum number of Picard iterations can be set using the namelist flag ``maxits_nonlin``. +The relative tolerance for the Picard solver can be set using the namelist flag ``reltol_nonlin``. +The Picard iterative process stops when :math:`\left\lVert \mathbf{u}_{k} \right\rVert_2 < {\tt reltol\_nonlin} \cdot \left\lVert\mathbf{u}_{0}\right\rVert_2` or when ``maxits_nonlin`` is reached. + +Parameters for the FGMRES linear solver and the preconditioner can be controlled using additional namelist flags (see :ref:`dynamics_nml`). + +Ice-Ocean stress +~~~~~~~~~~~~~~~~ + +At the end of each (thermodynamic) time step, the +ice–ocean stress must be constructed from :math:`{\tt taux(y)}` and the terms +containing :math:`{\tt vrel}` on the left hand side of the equations. The Hibler-Bryan form for the ice-ocean stress :cite:`Hibler87` is included in **ice\_dyn\_shared.F90** but is currently commented out, @@ -185,7 +266,7 @@ where the :math:`a_i` and :math:`v_i` are the total ice concentrations and ice v 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 weigth of the ridge +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 grounding scheme can be turned on or off using the namelist logical basalstress. @@ -207,47 +288,44 @@ For convenience we formulate the stress tensor :math:`\bf \sigma` in terms of :math:`\sigma_1=\sigma_{11}+\sigma_{22}`, :math:`\sigma_2=\sigma_{11}-\sigma_{22}`, and introduce the divergence, :math:`D_D`, and the horizontal tension and shearing -strain rates, :math:`D_T` and :math:`D_S` respectively. - -CICE now outputs the internal ice pressure which is an important field to support navigation in ice-infested water. -The internal ice pressure :math:`(sigP)` is the average of the normal stresses multiplied by :math:`-1` and -is therefore simply equal to :math:`-\sigma_1/2`. - -*Elastic-Viscous-Plastic* - -In the EVP model the internal stress tensor is determined from a -regularized version of the VP constitutive law. 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 constitutive law is therefore +strain rates, :math:`D_T` and :math:`D_S` respectively: .. math:: - {1\over E}{\partial\sigma_1\over\partial t} + {\sigma_1\over 2\zeta} - + {P_R(1-k_t)\over 2\zeta} = D_D, \\ - :label: sig1 + D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, .. math:: - {1\over E}{\partial\sigma_2\over\partial t} + {\sigma_2\over 2\eta} = D_T, - :label: sig2 + D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, .. math:: - {1\over E}{\partial\sigma_{12}\over\partial t} + {\sigma_{12}\over - 2\eta} = {1\over 2}D_S, - :label: sig12 + D_S = 2\dot{\epsilon}_{12}, where .. math:: - D_D = \dot{\epsilon}_{11} + \dot{\epsilon}_{22}, + \dot{\epsilon}_{ij} = {1\over 2}\left({{\partial u_i}\over{\partial x_j}} + {{\partial u_j}\over{\partial x_i}}\right) -.. math:: - D_T = \dot{\epsilon}_{11} - \dot{\epsilon}_{22}, +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 +is therefore simply equal to :math:`-\sigma_1/2`. -.. math:: - D_S = 2\dot{\epsilon}_{12}, +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``). + +.. _stress-vp: + +Viscous-Plastic +~~~~~~~~~~~~~~~ + +The VP constitutive law is given by .. math:: - \dot{\epsilon}_{ij} = {1\over 2}\left({{\partial u_i}\over{\partial x_j}} + {{\partial u_j}\over{\partial x_i}}\right), + \sigma_{ij} = 2 \eta \dot{\epsilon}_{ij} + (\zeta - \eta) D_D - P_R(1 - k_t)\frac{\delta_{ij}}{2} + :label: vp-const + +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}, @@ -255,14 +333,41 @@ where .. math:: \eta = {P(1+k_t)\over {2\Delta e^2}}, +where + .. math:: - \Delta = \left[D_D^2 + {1\over e^2}\left(D_T^2 + D_S^2\right)\right]^{1/2}, + \Delta = \left[D_D^2 + {1\over e^2}\left(D_T^2 + D_S^2\right)\right]^{1/2} and :math:`P_R` is a “replacement pressure” (see :cite:`Geiger98`, for example), which serves to prevent residual ice motion due to spatial -variations of :math:`P` when the rates of strain are exactly zero. The ice strength :math:`P` +variations of :math:`P` when the rates of strain are exactly zero. + +The ice strength :math:`P` is a function of the ice thickness and concentration -as it is described in the `Icepack Documentation `_. The parameteter :math:`e` is the ratio of the major and minor axes of the elliptical yield curve, also called the ellipse aspect ratio. It can be changed using the namelist parameter ``e_ratio``. +as described in the `Icepack Documentation `_. The parameter :math:`e` is the ratio of the major and minor axes of the elliptical yield curve, also called the ellipse aspect ratio. It can be changed using the namelist parameter ``e_ratio``. + +.. _stress-evp: + +Elastic-Viscous-Plastic +~~~~~~~~~~~~~~~~~~~~~~~ + +In the EVP model the internal stress tensor is determined from a +regularized version of the VP constitutive law :eq:`vp-const`. The constitutive law is therefore + +.. math:: + {1\over E}{\partial\sigma_1\over\partial t} + {\sigma_1\over 2\zeta} + + {P_R(1-k_t)\over 2\zeta} = D_D, \\ + :label: sig1 + +.. math:: + {1\over E}{\partial\sigma_2\over\partial t} + {\sigma_2\over 2\eta} = D_T, + :label: sig2 + +.. math:: + {1\over E}{\partial\sigma_{12}\over\partial t} + {\sigma_{12}\over + 2\eta} = {1\over 2}D_S, + :label: sig12 + Viscosities are updated during the subcycling, so that the entire dynamics component is subcycled within the time step, and the elastic @@ -304,15 +409,10 @@ appear explicitly.) Choices of the parameters used to define :math:`E`, :math:`T` and :math:`\Delta t_e` are discussed in Sections :ref:`revp` and :ref:`parameters`. -The bilinear discretization used for the stress terms -:math:`\partial\sigma_{ij}/\partial x_j` in the momentum equation is -now used, which enabled the discrete equations to be derived from the -continuous equations written in curvilinear coordinates. In this -manner, metric terms associated with the curvature of the grid are -incorporated into the discretization explicitly. Details pertaining to -the spatial discretization are found in :cite:`Hunke02`. +.. _stress-eap: -*Elastic-Anisotropic-Plastic* +Elastic-Anisotropic-Plastic +~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the EAP model the internal stress tensor is related to the geometrical properties and orientation of underlying virtual diamond @@ -558,6 +658,6 @@ Introducing another numerical parameter :math:`\alpha=2T \Delta t_e ^{-1}` :cite 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 = arlx` and :math:`\beta = brlx`. The values of :math:`arlx` and :math:`brlx` can be set in the namelist. -It is recommended to use large values of these parameters and to set :math:`arlx=brlx` :cite:`Kimmritz15`. +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`. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 032c8b529..227a63663 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -349,6 +349,8 @@ thermo_nml "``sw_dtemp``", "real", "temperature difference from melt to start redistributing", "0.02" "", "", "", "" +.. _dynamics_nml: + dynamics_nml ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -369,10 +371,13 @@ dynamics_nml "", "``zero``", "zero coriolis", "" "``Cstar``", "real", "constant in Hibler strength formula", "20" "``e_ratio``", "real", "EVP ellipse aspect ratio", "2.0" + "``dim_fgmres``", "integer", "maximum number of Arnoldi iterations for FGMRES solver", "50" + "``dim_pgmres``", "integer", "maximum number of Arnoldi iterations for PGMRES preconditioner", "5" "``kdyn``", "``-1``", "dynamics algorithm OFF", "1" "", "``0``", "dynamics OFF", "" "", "``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)", "" "``kstrength``", "``0``", "ice strength formulation :cite:`Hibler79`", "1" @@ -388,9 +393,23 @@ dynamics_nml "``Ktens``", "real", "Tensile strength factor (see :cite:`Konig10`)", "0.0" "``k1``", "real", "1st free parameter for landfast parameterization", "8.0" "``k2``", "real", "2nd free parameter (N/m\ :math:`^3`) for landfast parameterization", "15.0" + "``maxits_nonlin``", "integer", "maximum number of nonlinear iterations for VP solver", "1000" + "``maxits_fgmres``", "integer", "maximum number of restarts for FGMRES solver", "1" + "``maxits_pgmres``", "integer", "maximum number of restarts for PGMRES preconditioner", "1" + "``monitor_nonlin``", "logical", "write velocity norm at each nonlinear iteration", "``.false.``" + "``monitor_fgmres``", "logical", "write velocity norm at each FGMRES iteration", "``.false.``" + "``monitor_pgmres``", "logical", "write velocity norm at each PGMRES iteration", "``.false.``" "``mu_rdg``", "real", "e-folding scale of ridged ice for ``krdg_partic`` = 1 in m^0.5", "3.0" "``ndte``", "integer", "number of EVP subcycles", "120" + "``ortho_type``", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "``mgs``" + "", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "" + "``precond``", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "``pgmres``" + "", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "" + "", "``ident``", "Don't use a preconditioner for the FGMRES solver", "" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" + "``reltol_nonlin``", "real", "relative tolerance for nonlinear solver", "1e-8" + "``reltol_fgmres``", "real", "relative tolerance for FGMRES solver", "1e-2" + "``reltol_pgmres``", "real", "relative tolerance for PGMRES preconditioner", "1e-6" "``revised_evp``", "logical", "use revised EVP formulation", "``.false.``" "``ssh_stress``", "``coupled``", "computed from coupled sea surface height gradient", "``geostrophic``" "", "``geostropic``", "computed from ocean velocity", "" diff --git a/icepack b/icepack index 3b1ac0187..db2a47789 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 3b1ac0187ce30fbb950276b979376b041ca4467b +Subproject commit db2a4778970ae340b6bdd62eb03f60cd37a13f75 From 2eca569055a0bcbd0f72859bc7d71ba802231ffe Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 5 Apr 2021 08:29:35 -0400 Subject: [PATCH 33/44] update icepack --- .gitmodules | 3 +-- icepack | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index b84a13b43..8a773d230 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,3 @@ [submodule "icepack"] path = icepack - #url = https://github.com/NOAA-EMC/Icepack - url = https://github.com/DeniseWorthen/Icepack + url = https://github.com/NOAA-EMC/Icepack diff --git a/icepack b/icepack index 1fbea24e1..8bc17e1ee 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 1fbea24e1c364a02dea7068e977b4e1355aef917 +Subproject commit 8bc17e1eee235fb0e26857119175990aa0102613 From d8fb6d915b7d0c2e144d8b70e59639c2cfd061f2 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 2 Jun 2021 16:57:19 -0400 Subject: [PATCH 34/44] switch icepack branches * update to icepack master but set abort flag in ITD routine to false --- .gitmodules | 2 +- icepack | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 472a87b2e..a707591c3 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,4 +2,4 @@ path = icepack #url = https://github.com/NOAA-EMC/Icepack url = https://github.com/DeniseWorthen/Icepack - branch = feature/updcice + branch = feature/icepack_noabort diff --git a/icepack b/icepack index 5490d3369..2845c94d0 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 5490d3369238d32e463ff153bf34390ec54c4d4b +Subproject commit 2845c94d0b44bed5f5b7e7857fd90ca5c00df50e From 9a76541edadbb02910cbc88290484a32e4a7887b Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 4 Jun 2021 16:01:59 -0400 Subject: [PATCH 35/44] update icepack --- .gitmodules | 4 +--- icepack | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index a707591c3..8a773d230 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,5 +1,3 @@ [submodule "icepack"] path = icepack - #url = https://github.com/NOAA-EMC/Icepack - url = https://github.com/DeniseWorthen/Icepack - branch = feature/icepack_noabort + url = https://github.com/NOAA-EMC/Icepack diff --git a/icepack b/icepack index 2845c94d0..9a7e22089 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 2845c94d0b44bed5f5b7e7857fd90ca5c00df50e +Subproject commit 9a7e220890f70d2654314cbb023b9137f15d6327 From 519d3392d515ec3ff668a50974774c942222367a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 4 Jun 2021 16:41:08 -0400 Subject: [PATCH 36/44] Update CICE to latest Consortium master (#26) update CICE and Icepack * changes the criteria for aborting ice for thermo-conservation errors * updates the time manager * fixes two bugs in ice_therm_mushy * updates Icepack to Consortium master w/ flip of abort flag for troublesome IC cases --- .github/workflows/test-cice.yml | 8 +- cice.setup | 14 +- .../cicedynB/analysis/ice_diagnostics.F90 | 76 +- cicecore/cicedynB/analysis/ice_history.F90 | 8 +- .../cicedynB/analysis/ice_history_shared.F90 | 20 +- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 3 +- .../dynamics/ice_transport_driver.F90 | 36 +- cicecore/cicedynB/general/ice_flux.F90 | 11 +- cicecore/cicedynB/general/ice_forcing.F90 | 788 +++++++----- cicecore/cicedynB/general/ice_forcing_bgc.F90 | 44 +- cicecore/cicedynB/general/ice_init.F90 | 54 +- cicecore/cicedynB/general/ice_step_mod.F90 | 41 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 240 ++-- .../infrastructure/comm/mpi/ice_timers.F90 | 2 + .../comm/serial/ice_boundary.F90 | 226 ++-- .../infrastructure/comm/serial/ice_timers.F90 | 6 +- .../cicedynB/infrastructure/ice_blocks.F90 | 17 +- .../cicedynB/infrastructure/ice_domain.F90 | 63 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 78 +- .../infrastructure/ice_read_write.F90 | 31 +- .../infrastructure/ice_restart_driver.F90 | 20 +- .../cicedynB/infrastructure/ice_restoring.F90 | 5 + .../io/io_binary/ice_restart.F90 | 81 +- .../io/io_netcdf/ice_history_write.F90 | 16 +- .../io/io_netcdf/ice_restart.F90 | 64 +- .../io/io_pio2/ice_history_write.F90 | 15 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 74 +- cicecore/drivers/direct/hadgem3/CICE.F90 | 37 - .../drivers/direct/hadgem3/CICE_FinalMod.F90 | 31 - cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 | 31 - cicecore/drivers/mct/cesm1/CICE_InitMod.F90 | 8 +- cicecore/drivers/mct/cesm1/CICE_RunMod.F90 | 16 +- cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 | 27 +- cicecore/drivers/mct/cesm1/ice_comp_mct.F90 | 51 +- .../drivers/mct/cesm1/ice_prescribed_mod.F90 | 2 +- .../drivers/nuopc/cmeps/CICE_FinalMod.F90 | 31 - cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 12 +- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 14 +- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 40 +- .../nuopc/cmeps/ice_prescribed_mod.F90 | 2 +- cicecore/drivers/nuopc/dmi/CICE.F90 | 36 - cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 | 43 +- cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 | 27 +- cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 | 34 +- cicecore/drivers/standalone/cice/CICE.F90 | 36 - .../drivers/standalone/cice/CICE_FinalMod.F90 | 31 - .../drivers/standalone/cice/CICE_InitMod.F90 | 21 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 80 +- .../standalone/cice/CICE_RunMod.F90_debug | 704 ----------- cicecore/drivers/unittest/calchk/calchk.F90 | 588 +++++++++ .../unittest/helloworld/helloworld.F90 | 8 + cicecore/shared/ice_calendar.F90 | 1088 +++++++++++------ cicecore/shared/ice_distribution.F90 | 71 +- cicecore/shared/ice_init_column.F90 | 12 +- cicecore/shared/ice_spacecurve.F90 | 446 ++++--- cicecore/version.txt | 2 +- configuration/scripts/Makefile | 20 +- configuration/scripts/cice.batch.csh | 27 +- configuration/scripts/cice.build | 8 +- configuration/scripts/cice.launch.csh | 12 + configuration/scripts/cice.run.setup.csh | 12 +- configuration/scripts/cice.settings | 1 + configuration/scripts/cice_decomp.csh | 17 + configuration/scripts/ice_in | 17 +- .../scripts/machines/Macros.banting_intel | 2 +- .../scripts/machines/Macros.cheyenne_gnu | 1 + .../scripts/machines/Macros.cheyenne_intel | 4 +- .../scripts/machines/Macros.compy_intel | 44 + .../scripts/machines/Macros.conda_macos | 1 + .../scripts/machines/Macros.daley_intel | 2 +- .../scripts/machines/Macros.gaffney_intel | 2 +- .../scripts/machines/Macros.koehr_intel | 2 +- .../scripts/machines/Macros.mustang_intel18 | 1 + .../scripts/machines/Macros.mustang_intel19 | 1 + .../scripts/machines/Macros.mustang_intel20 | 1 + .../scripts/machines/Macros.onyx_intel | 1 + .../scripts/machines/env.cheyenne_gnu | 3 + .../scripts/machines/env.cheyenne_intel | 3 + .../scripts/machines/env.cheyenne_pgi | 3 + .../scripts/machines/env.compy_intel | 42 + configuration/scripts/options/set_env.calchk | 2 + .../scripts/options/set_env.helloworld | 2 + configuration/scripts/options/set_nml.alt01 | 2 +- configuration/scripts/options/set_nml.alt03 | 1 + configuration/scripts/options/set_nml.alt05 | 3 - configuration/scripts/options/set_nml.alt06 | 5 + configuration/scripts/options/set_nml.bgcz | 4 +- configuration/scripts/options/set_nml.bigdiag | 8 + configuration/scripts/options/set_nml.box2001 | 1 + configuration/scripts/options/set_nml.boxadv | 2 + .../{set_nml.boxdyn => set_nml.boxnodyn} | 3 + .../scripts/options/set_nml.boxrestore | 2 + .../scripts/options/set_nml.boxslotcyl | 2 + .../scripts/options/set_nml.debugblocks | 1 + .../scripts/options/set_nml.dspiralcenter | 1 + .../scripts/options/set_nml.dwghtfile | 3 + configuration/scripts/options/set_nml.gbox180 | 4 + configuration/scripts/options/set_nml.gx1 | 4 +- configuration/scripts/options/set_nml.gx1apr | 5 + .../scripts/options/set_nml.gx1coreii | 1 + configuration/scripts/options/set_nml.gx1prod | 23 +- configuration/scripts/options/set_nml.gx3sep2 | 6 + configuration/scripts/options/set_nml.ml | 7 + .../scripts/options/set_nml.run10day | 3 +- configuration/scripts/options/set_nml.run1day | 3 +- .../scripts/options/set_nml.run1year | 3 +- configuration/scripts/options/set_nml.run2day | 3 +- configuration/scripts/options/set_nml.run3day | 3 +- configuration/scripts/options/set_nml.run3dt | 1 + configuration/scripts/options/set_nml.run5day | 3 +- .../scripts/options/set_nml.run60day | 3 +- .../scripts/options/set_nml.run90day | 3 +- .../scripts/options/set_nml.seabedLKD | 6 + .../scripts/options/set_nml.seabedprob | 6 + .../scripts/options/test_nml.restart1 | 3 +- .../scripts/options/test_nml.restart2 | 3 +- configuration/scripts/tests/base_suite.ts | 13 +- configuration/scripts/tests/baseline.script | 102 +- configuration/scripts/tests/comparelog.csh | 34 +- configuration/scripts/tests/decomp_suite.ts | 53 +- configuration/scripts/tests/io_suite.ts | 6 + .../scripts/tests/lcov_modify_source.sh | 44 + configuration/scripts/tests/nothread_suite.ts | 6 +- configuration/scripts/tests/quick_suite.ts | 2 +- .../scripts/tests/report_results.csh | 10 +- .../scripts/tests/test_unittest.script | 24 + configuration/scripts/tests/unittest_suite.ts | 4 + .../convert_restarts.f90 | 0 .../interp_jra55_ncdf_bilinear.py | 441 +++++++ .../tools/jra55_datasets/make_forcing.csh | 49 + doc/source/cice_index.rst | 31 +- doc/source/conf.py | 4 +- doc/source/developer_guide/dg_dynamics.rst | 7 +- doc/source/developer_guide/dg_forcing.rst | 4 +- doc/source/developer_guide/dg_scripts.rst | 24 +- doc/source/developer_guide/dg_tools.rst | 150 +++ doc/source/developer_guide/index.rst | 1 + doc/source/user_guide/ug_case_settings.rst | 33 +- doc/source/user_guide/ug_implementation.rst | 133 +- doc/source/user_guide/ug_running.rst | 35 +- doc/source/user_guide/ug_testing.rst | 66 +- doc/source/user_guide/ug_troubleshooting.rst | 25 +- icepack | 2 +- 143 files changed, 4504 insertions(+), 2731 deletions(-) mode change 100644 => 100755 cicecore/cicedynB/general/ice_forcing.F90 delete mode 100644 cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug create mode 100644 cicecore/drivers/unittest/calchk/calchk.F90 create mode 100644 cicecore/drivers/unittest/helloworld/helloworld.F90 create mode 100644 configuration/scripts/machines/Macros.compy_intel create mode 100755 configuration/scripts/machines/env.compy_intel create mode 100644 configuration/scripts/options/set_env.calchk create mode 100644 configuration/scripts/options/set_env.helloworld create mode 100644 configuration/scripts/options/set_nml.alt06 create mode 100644 configuration/scripts/options/set_nml.bigdiag rename configuration/scripts/options/{set_nml.boxdyn => set_nml.boxnodyn} (88%) create mode 100644 configuration/scripts/options/set_nml.debugblocks create mode 100644 configuration/scripts/options/set_nml.dspiralcenter create mode 100644 configuration/scripts/options/set_nml.dwghtfile create mode 100644 configuration/scripts/options/set_nml.gbox180 create mode 100644 configuration/scripts/options/set_nml.gx1apr create mode 100644 configuration/scripts/options/set_nml.gx3sep2 create mode 100644 configuration/scripts/options/set_nml.ml create mode 100644 configuration/scripts/options/set_nml.seabedLKD create mode 100644 configuration/scripts/options/set_nml.seabedprob mode change 100755 => 100644 configuration/scripts/tests/base_suite.ts mode change 100755 => 100644 configuration/scripts/tests/io_suite.ts create mode 100755 configuration/scripts/tests/lcov_modify_source.sh create mode 100644 configuration/scripts/tests/test_unittest.script create mode 100644 configuration/scripts/tests/unittest_suite.ts rename configuration/tools/{ => cice4_restart_conversion}/convert_restarts.f90 (100%) create mode 100755 configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py create mode 100755 configuration/tools/jra55_datasets/make_forcing.csh create mode 100644 doc/source/developer_guide/dg_tools.rst diff --git a/.github/workflows/test-cice.yml b/.github/workflows/test-cice.yml index 1fdd8188d..32e784564 100644 --- a/.github/workflows/test-cice.yml +++ b/.github/workflows/test-cice.yml @@ -17,7 +17,7 @@ on: defaults: run: - shell: /bin/csh {0} + shell: /bin/csh -e {0} jobs: build: @@ -104,9 +104,9 @@ jobs: - name: download input data run: | cd $HOME/cice-dirs/input - wget https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz - wget https://zenodo.org/record/3728362/files/CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz - wget https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728358/files/CICE_data_gx3_grid_ic-20200320.tar.gz && tar xvfz CICE_data_gx3_grid_ic-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728362/files/CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_NCAR_bulk-20200320.tar.gz + wget --progress=dot:giga https://zenodo.org/record/3728364/files/CICE_data_gx3_forcing_JRA55-20200320.tar.gz && tar xvfz CICE_data_gx3_forcing_JRA55-20200320.tar.gz pwd ls -alR # - name: run case diff --git a/cice.setup b/cice.setup index 3efe94827..8dc46005a 100755 --- a/cice.setup +++ b/cice.setup @@ -390,6 +390,18 @@ if ((${dosuite} == 1 || ${dotest} == 1) && ${testid} == ${spval}) then exit -1 endif +# This creates a new sandbox and modifies the source code for "improved" lcov analysis +# Turn this if block off if you don't want coverage to do that +if ($coverage == 1) then + set sandbox_lcov = ${ICE_SANDBOX}/../cice_lcov_${sdate}-${stime} + cp -p -r ${ICE_SANDBOX} ${sandbox_lcov} + echo "shifting to sandbox = ${sandbox_lcov}" + set ICE_SANDBOX = ${sandbox_lcov} + set ICE_SCRIPTS = "${ICE_SANDBOX}/configuration/scripts" + cd ${ICE_SANDBOX} + ${ICE_SCRIPTS}/tests/lcov_modify_source.sh +endif + #--------------------------------------------------------------------- # Setup tsfile and test suite support stuff @@ -1094,7 +1106,7 @@ cd ${testname_base} source ./cice.settings if (\${dobuild} == true) then if (\${doreuse} == true) then - set ciceexe = "../ciceexe.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" + set ciceexe = "../ciceexe.\${ICE_TARGET}.\${ICE_ENVNAME}.\${ICE_COMMDIR}.\${ICE_BLDDEBUG}.\${ICE_THREADED}.\${ICE_IOTYPE}" ./cice.build --exe \${ciceexe} if !(-e \${ciceexe}) cp -p \${ICE_RUNDIR}/cice \${ciceexe} else diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index cff544cd4..3eaf9d057 100644 --- a/cicecore/cicedynB/analysis/ice_diagnostics.F90 +++ b/cicecore/cicedynB/analysis/ice_diagnostics.F90 @@ -25,9 +25,8 @@ module ice_diagnostics implicit none private - public :: runtime_diags, init_mass_diags, init_diags, & - print_state, print_points_state, diagnostic_abort - + public :: runtime_diags, init_mass_diags, init_diags, debug_ice, & + print_state, diagnostic_abort ! diagnostic output file character (len=char_len), public :: diag_file @@ -35,9 +34,13 @@ module ice_diagnostics ! point print data logical (kind=log_kind), public :: & + debug_model , & ! if true, debug model at high level print_points , & ! if true, print point data print_global ! if true, print global data + integer (kind=int_kind), public :: & + debug_model_step = 999999999 ! begin printing at istep1=debug_model_step + integer (kind=int_kind), parameter, public :: & npnt = 2 ! total number of points to be printed @@ -87,16 +90,6 @@ module ice_diagnostics totaeron , & ! total aerosol mass totaeros ! total aerosol mass - ! printing info for routine print_state - ! iblkp, ip, jp, mtask identify the grid cell to print -! character (char_len) :: plabel - integer (kind=int_kind), parameter, public :: & - check_step = 999999999, & ! begin printing at istep1=check_step - iblkp = 1, & ! block number - ip = 72, & ! i index - jp = 11, & ! j index - mtask = 0 ! my_task - !======================================================================= contains @@ -1525,20 +1518,39 @@ end subroutine init_diags !======================================================================= -! This routine is useful for debugging. -! Calls to it should be inserted in the form (after thermo, for example) -! do iblk = 1, nblocks -! do j=jlo,jhi -! do i=ilo,ihi -! plabel = 'post thermo' -! if (istep1 >= check_step .and. iblk==iblkp .and i==ip & -! .and. j==jp .and. my_task == mtask) & -! call print_state(plabel,i,j,iblk) -! enddo -! enddo +! This routine is useful for debugging +! author Elizabeth C. Hunke, LANL + + subroutine debug_ice(iblk, plabeld) + + use ice_kinds_mod + use ice_calendar, only: istep1 + use ice_communicate, only: my_task + use ice_blocks, only: nx_block, ny_block + + character (char_len), intent(in) :: plabeld + integer (kind=int_kind), intent(in) :: iblk + + ! local + integer (kind=int_kind) :: i, j, m + character(len=*), parameter :: subname='(debug_ice)' + +! tcraig, do this only on one point, the first point +! do m = 1, npnt + m = 1 + if (istep1 >= debug_model_step .and. & + iblk == pbloc(m) .and. my_task == pmloc(m)) then + i = piloc(m) + j = pjloc(m) + call print_state(plabeld,i,j,iblk) + endif ! enddo -! -! 'use ice_diagnostics' may need to be inserted also + + end subroutine debug_ice + +!======================================================================= + +! This routine is useful for debugging. ! author: Elizabeth C. Hunke, LANL subroutine print_state(plabel,i,j,iblk) @@ -1587,7 +1599,7 @@ subroutine print_state(plabel,i,j,iblk) this_block = get_block(blocks_ice(iblk),iblk) - write(nu_diag,*) plabel + write(nu_diag,*) subname,plabel write(nu_diag,*) 'istep1, my_task, i, j, iblk:', & istep1, my_task, i, j, iblk write(nu_diag,*) 'Global i and j:', & @@ -1699,16 +1711,14 @@ subroutine print_state(plabel,i,j,iblk) write(nu_diag,*) ' evap = ',evap (i,j,iblk) write(nu_diag,*) ' flwout = ',flwout(i,j,iblk) write(nu_diag,*) ' ' + call flush_fileunit(nu_diag) end subroutine print_state !======================================================================= +#ifdef UNDEPRECATE_print_points_state ! This routine is useful for debugging. -! Calls can be inserted anywhere and it will print info on print_points points -! call print_points_state(plabel) -! -! 'use ice_diagnostics' may need to be inserted also subroutine print_points_state(plabel,ilabel) @@ -1764,6 +1774,7 @@ subroutine print_points_state(plabel,ilabel) write(llabel,'(a)') 'pps:'//trim(llabel) endif + write(nu_diag,*) subname write(nu_diag,*) trim(llabel),'istep1, my_task, i, j, iblk=', & istep1, my_task, i, j, iblk write(nu_diag,*) trim(llabel),'Global i and j=', & @@ -1842,12 +1853,13 @@ subroutine print_points_state(plabel,ilabel) write(nu_diag,*) ' evap = ',evap (i,j,iblk) write(nu_diag,*) ' flwout = ',flwout(i,j,iblk) write(nu_diag,*) ' ' + call flush_fileunit(nu_diag) endif ! my_task enddo ! ncnt end subroutine print_points_state - +#endif !======================================================================= ! prints error information prior to aborting diff --git a/cicecore/cicedynB/analysis/ice_history.F90 b/cicecore/cicedynB/analysis/ice_history.F90 index 1aa2515a4..f91562449 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -1713,7 +1713,7 @@ subroutine accum_hist (dt) use ice_domain_size, only: nfsd use ice_grid, only: tmask, lmask_n, lmask_s, dxu, dyu use ice_calendar, only: new_year, write_history, & - write_ic, time, histfreq, nstreams, month, & + write_ic, timesecs, histfreq, nstreams, mmonth, & new_month use ice_dyn_eap, only: a11, a12, e11, e12, e22, s11, s12, s22, & yieldstress11, yieldstress12, yieldstress22 @@ -1864,7 +1864,7 @@ subroutine accum_hist (dt) avgct(ns) = avgct(ns) + c1 ! if (avgct(ns) == c1) time_beg(ns) = (time-dt)/int(secday) if (avgct(ns) == c1) then - time_beg(ns) = (time-dt)/int(secday) + time_beg(ns) = (timesecs-dt)/int(secday) time_beg(ns) = real(time_beg(ns),kind=real_kind) endif endif @@ -3966,7 +3966,7 @@ subroutine accum_hist (dt) enddo ! iblk !$OMP END PARALLEL DO - time_end(ns) = time/int(secday) + time_end(ns) = timesecs/int(secday) time_end(ns) = real(time_end(ns),kind=real_kind) !--------------------------------------------------------------- @@ -4057,7 +4057,7 @@ subroutine accum_hist (dt) enddo endif ! new_year - if ( (month .eq. 7) .and. new_month ) then + if ( (mmonth .eq. 7) .and. new_month ) then do j=jlo,jhi do i=ilo,ihi ! reset SH Jul 1 diff --git a/cicecore/cicedynB/analysis/ice_history_shared.F90 b/cicecore/cicedynB/analysis/ice_history_shared.F90 index ce177ad1e..52d268990 100644 --- a/cicecore/cicedynB/analysis/ice_history_shared.F90 +++ b/cicecore/cicedynB/analysis/ice_history_shared.F90 @@ -653,9 +653,9 @@ module ice_history_shared subroutine construct_filename(ncfile,suffix,ns) - use ice_calendar, only: sec, nyr, month, daymo, & + use ice_calendar, only: msec, myear, mmonth, daymo, & mday, write_ic, histfreq, histfreq_n, & - year_init, new_year, new_month, new_day, & + new_year, new_month, new_day, & dt use ice_restart_shared, only: lenstr @@ -667,12 +667,12 @@ subroutine construct_filename(ncfile,suffix,ns) character (len=1) :: cstream character(len=*), parameter :: subname = '(construct_filename)' - iyear = nyr + year_init - 1 ! set year_init=1 in ice_in to get iyear=nyr - imonth = month + iyear = myear + imonth = mmonth iday = mday - isec = sec - dt + isec = msec - dt - if (write_ic) isec = sec + if (write_ic) isec = msec ! construct filename if (write_ic) then write(ncfile,'(a,a,i4.4,a,i2.2,a,i2.2,a,i5.5,a,a)') & @@ -688,7 +688,7 @@ subroutine construct_filename(ncfile,suffix,ns) imonth = 12 iday = daymo(imonth) elseif (new_month) then - imonth = month - 1 + imonth = mmonth - 1 iday = daymo(imonth) elseif (new_day) then iday = iday - 1 @@ -703,7 +703,7 @@ subroutine construct_filename(ncfile,suffix,ns) 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,'-',sec,'.',suffix + iyear,'-',imonth,'-',iday,'-',msec,'.',suffix elseif (hist_avg) then ! write averaged data @@ -714,7 +714,7 @@ subroutine construct_filename(ncfile,suffix,ns) 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,'-',sec,'.',suffix + 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),'.', & @@ -728,7 +728,7 @@ subroutine construct_filename(ncfile,suffix,ns) 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,'-',sec,'.',suffix + iyear,'-',imonth,'-',iday,'-',msec,'.',suffix endif endif diff --git a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 index d8ce42681..2206e0de7 100644 --- a/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 +++ b/cicecore/cicedynB/dynamics/ice_dyn_evp.F90 @@ -361,8 +361,7 @@ subroutine evp (dt) 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') + 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, & diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index c500e1631..e3da6390b 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -272,7 +272,7 @@ subroutine transport_remap (dt) trmask ! = 1. if tracer is present, = 0. otherwise logical (kind=log_kind) :: & - l_stop ! if true, abort the model + ckflag ! if true, abort the model integer (kind=int_kind) :: & istop, jstop ! indices of grid cell where model aborts @@ -327,7 +327,7 @@ subroutine transport_remap (dt) !---! Initialize, update ghost cells, fill tracer arrays. !---!------------------------------------------------------------------- - l_stop = .false. + ckflag = .false. istop = 0 jstop = 0 @@ -605,10 +605,10 @@ subroutine transport_remap (dt) if (my_task == master_task) then fieldid = subname//':000' - call global_conservation (l_stop, fieldid, & + call global_conservation (ckflag, fieldid, & asum_init(0), asum_final(0)) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task =', & istep1, my_task write (nu_diag,*) 'transport: conservation error, cat 0' @@ -618,11 +618,11 @@ subroutine transport_remap (dt) do n = 1, ncat write(fieldid,'(a,i3.3)') subname,n call global_conservation & - (l_stop, fieldid, & + (ckflag, fieldid, & asum_init(n), asum_final(n), & atsum_init(:,n), atsum_final(:,n)) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task, cat =', & istep1, my_task, n write (nu_diag,*) 'transport: conservation error, cat ',n @@ -639,7 +639,7 @@ subroutine transport_remap (dt) !------------------------------------------------------------------- if (l_monotonicity_check) then - !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,l_stop,istop,jstop) + !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block,n,ckflag,istop,jstop) do iblk = 1, nblocks this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo @@ -647,7 +647,7 @@ subroutine transport_remap (dt) jlo = this_block%jlo jhi = this_block%jhi - l_stop = .false. + ckflag = .false. istop = 0 jstop = 0 @@ -657,10 +657,10 @@ subroutine transport_remap (dt) ilo, ihi, jlo, jhi, & tmin(:,:,:,n,iblk), tmax(:,:,:,n,iblk), & aim (:,:, n,iblk), trm (:,:,:,n,iblk), & - l_stop, & + ckflag, & istop, jstop) - if (l_stop) then + if (ckflag) then write (nu_diag,*) 'istep1, my_task, iblk, cat =', & istep1, my_task, iblk, n call abort_ice(subname//'ERROR: monotonicity error') @@ -1083,7 +1083,7 @@ end subroutine tracers_to_state ! ! author William H. Lipscomb, LANL - subroutine global_conservation (l_stop, fieldid, & + subroutine global_conservation (ckflag, fieldid, & asum_init, asum_final, & atsum_init, atsum_final) @@ -1099,7 +1099,7 @@ subroutine global_conservation (l_stop, fieldid, & atsum_final ! final global ice area*tracer logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return + ckflag ! if true, abort on return ! local variables @@ -1120,7 +1120,7 @@ subroutine global_conservation (l_stop, fieldid, & if (asum_init > puny) then diff = asum_final - asum_init if (abs(diff/asum_init) > puny) then - l_stop = .true. + ckflag = .true. write (nu_diag,*) write (nu_diag,*) subname,'Ice area conserv error ', trim(fieldid) write (nu_diag,*) subname,' Initial global area =', asum_init @@ -1135,7 +1135,7 @@ subroutine global_conservation (l_stop, fieldid, & if (abs(atsum_init(nt)) > puny) then diff = atsum_final(nt) - atsum_init(nt) if (abs(diff/atsum_init(nt)) > puny) then - l_stop = .true. + ckflag = .true. write (nu_diag,*) write (nu_diag,*) subname,'Ice area*tracer conserv error ', trim(fieldid),nt write (nu_diag,*) subname,' Tracer index =', nt @@ -1323,7 +1323,7 @@ subroutine check_monotonicity (nx_block, ny_block, & ilo, ihi, jlo, jhi, & tmin, tmax, & aim, trm, & - l_stop, & + ckflag, & istop, jstop) integer (kind=int_kind), intent(in) :: & @@ -1341,7 +1341,7 @@ subroutine check_monotonicity (nx_block, ny_block, & tmax ! local max tracer logical (kind=log_kind), intent(inout) :: & - l_stop ! if true, abort on return + ckflag ! if true, abort on return integer (kind=int_kind), intent(inout) :: & istop, jstop ! indices of grid cell where model aborts @@ -1425,7 +1425,7 @@ subroutine check_monotonicity (nx_block, ny_block, & w1 = max(c1, abs(tmin(i,j,nt))) w2 = max(c1, abs(tmax(i,j,nt))) if (trm(i,j,nt) < tmin(i,j,nt)-w1*puny) then - l_stop = .true. + ckflag = .true. istop = i jstop = j write (nu_diag,*) ' ' @@ -1435,7 +1435,7 @@ subroutine check_monotonicity (nx_block, ny_block, & write (nu_diag,*) 'tmin =' , tmin(i,j,nt) write (nu_diag,*) 'ice area =' , aim(i,j) elseif (trm(i,j,nt) > tmax(i,j,nt)+w2*puny) then - l_stop = .true. + ckflag = .true. istop = i jstop = j write (nu_diag,*) ' ' diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 71253a4b1..06b371c3c 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -547,7 +547,8 @@ subroutine init_coupler_flux integer (kind=int_kind) :: n - real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6) + integer (kind=int_kind), parameter :: max_d = 6 + real (kind=dbl_kind) :: fcondtopn_d(max_d), fsurfn_d(max_d) real (kind=dbl_kind) :: stefan_boltzmann, Tffresh real (kind=dbl_kind) :: vonkar, zref, iceruf @@ -589,7 +590,7 @@ subroutine init_coupler_flux flw (:,:,:) = c180 ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! conductive heat flux (W/m^2) - fcondtopn_f(:,:,n,:) = fcondtopn_d(n) + fcondtopn_f(:,:,n,:) = fcondtopn_d(min(n,max_d)) enddo fsurfn_f = fcondtopn_f ! surface heat flux (W/m^2) flatn_f (:,:,:,:) = c0 ! latent heat flux (kg/m2/s) @@ -606,7 +607,7 @@ subroutine init_coupler_flux flw (:,:,:) = 280.0_dbl_kind ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! surface heat flux (W/m^2) - fsurfn_f(:,:,n,:) = fsurfn_d(n) + fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d)) enddo fcondtopn_f(:,:,:,:) = 0.0_dbl_kind ! conductive heat flux (W/m^2) flatn_f (:,:,:,:) = -2.0_dbl_kind ! latent heat flux (W/m^2) @@ -623,7 +624,7 @@ subroutine init_coupler_flux flw (:,:,:) = 230.0_dbl_kind ! incoming longwave rad (W/m^2) frain (:,:,:) = c0 ! rainfall rate (kg/m2/s) do n = 1, ncat ! surface heat flux (W/m^2) - fsurfn_f(:,:,n,:) = fsurfn_d(n) + fsurfn_f(:,:,n,:) = fsurfn_d(min(n,max_d)) enddo fcondtopn_f(:,:,:,:) = c0 ! conductive heat flux (W/m^2) flatn_f (:,:,:,:) = -1.0_dbl_kind ! latent heat flux (W/m^2) @@ -654,9 +655,7 @@ subroutine init_coupler_flux enddo enddo -#ifndef CICE_IN_NEMO sst (:,:,:) = Tf(:,:,:) ! sea surface temp (C) -#endif qdp (:,:,:) = c0 ! deep ocean heat flux (W/m^2) hmix (:,:,:) = c20 ! ocean mixed layer depth (m) hwater(:,:,:) = bathymetry(:,:,:) ! ocean water depth (m) diff --git a/cicecore/cicedynB/general/ice_forcing.F90 b/cicecore/cicedynB/general/ice_forcing.F90 old mode 100644 new mode 100755 index edbba8101..200b3d00b --- a/cicecore/cicedynB/general/ice_forcing.F90 +++ b/cicecore/cicedynB/general/ice_forcing.F90 @@ -22,16 +22,16 @@ module ice_forcing use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: ncat, max_blocks, nx_global, ny_global use ice_communicate, only: my_task, master_task - use ice_calendar, only: istep, istep1, time, time_forc, & - sec, mday, month, nyr, yday, daycal, dayyr, & - daymo, days_per_year, hc_jday + use ice_calendar, only: istep, istep1, & + msec, mday, mmonth, myear, yday, daycal, & + daymo, days_per_year, compute_days_between use ice_fileunits, only: nu_diag, nu_forcing use ice_exit, only: abort_ice use ice_read_write, only: ice_open, ice_read, & ice_get_ncvarsize, ice_read_vec_nc, & ice_open_nc, ice_read_nc, ice_close_nc use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite, & - timer_bound + timer_bound, timer_forcing use ice_arrays_column, only: oceanmixed_ice, restore_bgc use ice_constants, only: c0, c1, c2, c3, c4, c5, c8, c10, c12, c15, c20, & c180, c360, c365, c1000, c3600 @@ -53,10 +53,10 @@ module ice_forcing read_data_nc_point, interp_coeff integer (kind=int_kind), public :: & - ycycle , & ! number of years in forcing cycle - fyear_init , & ! first year of data in forcing cycle - fyear , & ! current year in forcing cycle - fyear_final ! last year in cycle + ycycle , & ! number of years in forcing cycle, set by namelist + fyear_init , & ! first year of data in forcing cycle, set by namelist + fyear , & ! current year in forcing cycle, varying during the run + fyear_final ! last year in cycle, computed at init character (char_len_long) :: & ! input data file names uwind_file, & @@ -80,8 +80,7 @@ module ice_forcing botmelt_file real (kind=dbl_kind), public :: & - c1intp, c2intp , & ! interpolation coefficients - ftime ! forcing time (for restart) + c1intp, c2intp ! interpolation coefficients integer (kind=int_kind) :: & oldrecnum = 0 , & ! old record number (save between steps) @@ -159,7 +158,7 @@ module ice_forcing trest ! restoring time scale (sec) logical (kind=log_kind), public :: & - dbug ! prints debugging output if true + forcing_diag ! prints forcing debugging output if true real (dbl_kind), dimension(:), allocatable, public :: & jday_atm ! jday time vector from atm forcing files @@ -167,6 +166,15 @@ module ice_forcing integer (kind=int_kind), public :: & Njday_atm ! Number of atm forcing timesteps + + ! PRIVATE: + + real (dbl_kind), parameter :: & + mixed_layer_depth_default = c20 ! default mixed layer depth in m + + logical (kind=log_kind), parameter :: & + forcing_debug = .false. ! local debug flag + !======================================================================= contains @@ -177,6 +185,9 @@ module ice_forcing ! subroutine alloc_forcing integer (int_kind) :: ierr + character(len=*), parameter :: subname = '(alloc_forcing)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' allocate ( & cldf(nx_block,ny_block, max_blocks), & ! cloud fraction @@ -221,14 +232,20 @@ subroutine init_forcing_atmo use ice_calendar, only: use_leap_years + integer (kind=int_kind) :: modadj ! adjustment for mod function character(len=*), parameter :: subname = '(init_forcing_atmo)' - ! Allocate forcing arrays - call alloc_forcing() + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' - fyear = fyear_init + mod(nyr-1,ycycle) ! current year + modadj = abs((min(0,myear-fyear_init)/ycycle+1)*ycycle) + fyear = fyear_init + mod(myear-fyear_init+modadj,ycycle) fyear_final = fyear_init + ycycle - 1 ! last year in forcing cycle + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear,fyear_init,fyear_final + write(nu_diag,*) subname,'fdbg atm_data_type = ',trim(atm_data_type) + endif + if (trim(atm_data_type) /= 'default' .and. & my_task == master_task) then write (nu_diag,*) ' Initial forcing data year = ',fyear_init @@ -327,15 +344,19 @@ subroutine init_forcing_ocn(dt) character(len=*), parameter :: subname = '(init_forcing_ocn)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -! sst_data(:,:,:,:) = c0 -! sss_data(:,:,:,:) = c0 -! uocn_data(:,:,:,:) = c0 -! vocn_data(:,:,:,:) = c0 + call alloc_forcing() + + sst_data(:,:,:,:) = c0 + sss_data(:,:,:,:) = c0 + uocn_data(:,:,:,:) = c0 + vocn_data(:,:,:,:) = c0 nbits = 64 ! double precision data @@ -368,7 +389,7 @@ subroutine init_forcing_ocn(dt) sss(:,:,:) = c0 do k = 1,12 ! loop over 12 months - call ice_read (nu_forcing, k, work1, 'rda8', dbug, & + call ice_read (nu_forcing, k, work1, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks @@ -415,7 +436,7 @@ subroutine init_forcing_ocn(dt) if (my_task == master_task) & call ice_open (nu_forcing, sst_file, nbits) - call ice_read (nu_forcing, month, sst, 'rda8', dbug, & + call ice_read (nu_forcing, mmonth, sst, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) if (my_task == master_task) close(nu_forcing) @@ -451,7 +472,7 @@ subroutine init_forcing_ocn(dt) endif fieldname='sst' - call ice_read_nc(fid,month,fieldname,sst,diag) + call ice_read_nc(fid,mmonth,fieldname,sst,diag) if (my_task == master_task) call ice_close_nc(fid) @@ -469,8 +490,8 @@ subroutine init_forcing_ocn(dt) endif ! ocn_data_type if (trim(ocn_data_type) == 'ncar') then -! call ocn_data_ncar_init - call ocn_data_ncar_init_3D + call ocn_data_ncar_init +! call ocn_data_ncar_init_3D endif if (trim(ocn_data_type) == 'hycom') then @@ -499,6 +520,8 @@ subroutine ocn_freezing_temperature character(len=*), parameter :: subname = '(ocn_freezing_temperature)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block @@ -533,7 +556,8 @@ subroutine get_forcing_atmo integer (kind=int_kind) :: & iblk, & ! block index ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - fyear_old, & ! prior fyear value + modadj, & ! adjustment to make mod a postive number + fyear_old, & ! fyear setting on last timestep nt_Tsfc type (block) :: & @@ -541,12 +565,17 @@ subroutine get_forcing_atmo character(len=*), parameter :: subname = '(get_forcing_atmo)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + + call ice_timer_start(timer_forcing) + fyear_old = fyear - fyear = fyear_init + mod(nyr-1,ycycle) ! current year + modadj = abs((min(0,myear-fyear_init)/ycycle+1)*ycycle) + fyear = fyear_init + mod(myear-fyear_init+modadj,ycycle) if (trim(atm_data_type) /= 'default' .and. & (istep <= 1 .or. fyear /= fyear_old)) then if (my_task == master_task) then - write (nu_diag,*) ' Current forcing data year = ',fyear + write (nu_diag,*) ' Set current forcing data year = ',fyear endif endif @@ -555,23 +584,25 @@ subroutine get_forcing_atmo if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - ftime = time ! forcing time - time_forc = ftime ! for restarting + !------------------------------------------------------------------- + ! Read and interpolate atmospheric data + !------------------------------------------------------------------- - !------------------------------------------------------------------- - ! Read and interpolate atmospheric data - !------------------------------------------------------------------- + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear + write(nu_diag,*) subname,'fdbg atm_data_type = ',trim(atm_data_type) + endif if (trim(atm_data_type) == 'ncar') then call ncar_data elseif (trim(atm_data_type) == 'LYq') then call LY_data elseif (trim(atm_data_type) == 'JRA55_gx1') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'JRA55_gx3') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'JRA55_tx1') then - call JRA55_data(fyear) + call JRA55_data elseif (trim(atm_data_type) == 'hadgem') then call hadgem_data elseif (trim(atm_data_type) == 'monthly') then @@ -586,9 +617,9 @@ subroutine get_forcing_atmo return endif - !------------------------------------------------------------------- - ! Convert forcing data to fields needed by ice model - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! Convert forcing data to fields needed by ice model + !------------------------------------------------------------------- !$OMP PARALLEL DO PRIVATE(iblk,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks @@ -640,6 +671,8 @@ subroutine get_forcing_atmo field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) + call ice_timer_stop(timer_forcing) + end subroutine get_forcing_atmo !======================================================================= @@ -655,6 +688,15 @@ subroutine get_forcing_ocn (dt) character(len=*), parameter :: subname = '(get_forcing_ocn)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + + call ice_timer_start(timer_forcing) + + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg fyear = ',fyear + write(nu_diag,*) subname,'fdbg ocn_data_type = ',trim(ocn_data_type) + endif + if (trim(ocn_data_type) == 'clim') then call ocn_data_clim(dt) elseif (trim(ocn_data_type) == 'ncar' .or. & @@ -670,6 +712,8 @@ subroutine get_forcing_ocn (dt) !MHRI: NOT IMPLEMENTED YET endif + call ice_timer_stop(timer_forcing) + end subroutine get_forcing_ocn !======================================================================= @@ -694,7 +738,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & ! data is missing, and we assume periodicity when monthly data ! is missing. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -726,13 +770,15 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing nbits = 64 ! double precision data - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -770,7 +816,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = 1 nrec = recd + n2 call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixx==1 .and. my_task == master_task) close(nu_forcing) endif ! ixm ne -99 @@ -782,7 +828,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = arg + 1 nrec = recd + ixx call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixp /= -99) then ! currently in latter half of data interval @@ -807,7 +853,7 @@ subroutine read_data (flag, recd, yr, ixm, ixx, ixp, & arg = arg + 1 nrec = recd + n4 call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif ! ixp /= -99 if (my_task == master_task) close(nu_forcing) @@ -842,7 +888,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & ! ! Adapted by Alison McLaren, Met Office from read_data - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -860,16 +906,14 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & fieldname ! field name in netCDF file integer (kind=int_kind), intent(in) :: & - field_loc, & ! location of field on staggered grid - field_type ! type of field (scalar, vector, angle) + field_loc, & ! location of field on staggered grid + field_type ! type of field (scalar, vector, angle) real (kind=dbl_kind), dimension(nx_block,ny_block,2,max_blocks), intent(out) :: & field_data ! 2 values needed for interpolation ! local variables - character(len=*), parameter :: subname = '(read_data_nc)' - integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -877,11 +921,15 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & arg , & ! value of time argument in field_data fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -920,7 +968,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n2 call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) if (ixx==1) call ice_close_nc(fid) @@ -934,7 +982,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + ixx call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) if (ixp /= -99) then @@ -960,7 +1008,7 @@ subroutine read_data_nc (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n4 call ice_read_nc & - (fid, nrec, fieldname, field_data(:,:,arg,:), dbug, & + (fid, nrec, fieldname, field_data(:,:,arg,:), forcing_diag, & field_loc, field_type) endif ! ixp /= -99 @@ -986,7 +1034,7 @@ subroutine read_data_nc_hycom (flag, recd, & ! ! Adapted by Mads Hvid Ribergaard, DMI from read_data_nc - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step use ice_timers, only: ice_timer_start, ice_timer_stop, timer_readwrite logical (kind=log_kind), intent(in) :: flag @@ -1011,11 +1059,15 @@ subroutine read_data_nc_hycom (flag, recd, & integer (kind=int_kind) :: & fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc_hycom)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -1026,11 +1078,11 @@ subroutine read_data_nc_hycom (flag, recd, & ! read data !----------------------------------------------------------------- call ice_read_nc & - (fid, recd , fieldname, field_data(:,:,1,:), dbug, & + (fid, recd , fieldname, field_data(:,:,1,:), forcing_diag, & field_loc, field_type) call ice_read_nc & - (fid, recd+1, fieldname, field_data(:,:,2,:), dbug, & + (fid, recd+1, fieldname, field_data(:,:,2,:), forcing_diag, & field_loc, field_type) call ice_close_nc(fid) @@ -1052,7 +1104,7 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & ! no need to get data from other years or to extrapolate data beyond ! the forcing time period. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind),intent(in) :: readflag @@ -1079,13 +1131,15 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_clim_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing nbits = 64 ! double precision data - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) & + if (my_task==master_task .and. (forcing_diag)) & write(nu_diag,*) ' ', trim(data_file) if (readflag) then @@ -1101,19 +1155,19 @@ subroutine read_clim_data (readflag, recd, ixm, ixx, ixp, & arg = 1 nrec = recd + ixm call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif arg = arg + 1 nrec = recd + ixx call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) if (ixp /= -99) then arg = arg + 1 nrec = recd + ixp call ice_read (nu_forcing, nrec, field_data(:,:,arg,:), & - 'rda8', dbug, field_loc, field_type) + 'rda8', forcing_diag, field_loc, field_type) endif if (my_task == master_task) close (nu_forcing) @@ -1134,7 +1188,7 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & ! no need to get data from other years or to extrapolate data beyond ! the forcing time period. - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind),intent(in) :: readflag @@ -1164,11 +1218,13 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & character(len=*), parameter :: subname = '(read_clim_data_nc)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) & + if (my_task==master_task .and. (forcing_diag)) & write(nu_diag,*) ' ', trim(data_file) if (readflag) then @@ -1185,21 +1241,21 @@ subroutine read_clim_data_nc (readflag, recd, ixm, ixx, ixp, & nrec = recd + ixm call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) endif arg = arg + 1 nrec = recd + ixx call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) if (ixp /= -99) then arg = arg + 1 nrec = recd + ixp call ice_read_nc & (fid, nrec, fieldname, field_data(:,:,arg,:), & - dbug, field_loc, field_type) + forcing_diag, field_loc, field_type) endif if (my_task == master_task) call ice_close_nc (fid) @@ -1222,14 +1278,16 @@ subroutine interp_coeff_monthly (recslot) real (kind=dbl_kind) :: & secday , & ! seconds in day - tt , & ! seconds elapsed in current year - t1, t2 ! seconds elapsed at month midpoint + tt , & ! days elapsed in current year + t1, t2 ! days elapsed at month midpoint real (kind=dbl_kind) :: & daymid(0:13) ! month mid-points character(len=*), parameter :: subname = '(interp_coeff_monthly)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1238,21 +1296,27 @@ subroutine interp_coeff_monthly (recslot) daymid(1:13) = 14._dbl_kind ! time frame ends 0 sec into day 15 daymid(0) = 14._dbl_kind - daymo(12) ! Dec 15, 0 sec - ! make time cyclic - tt = mod(ftime/secday,dayyr) + ! compute days since Jan 1, 00h, yday is the day counter for the year + tt = real(yday-1,kind=dbl_kind) + real(msec,kind=dbl_kind)/secday ! Find neighboring times if (recslot==2) then ! first half of month - t2 = daycal(month) + daymid(month) ! midpoint, current month - if (month == 1) then + t2 = daycal(mmonth) + daymid(mmonth) ! midpoint, current month + if (mmonth == 1) then t1 = daymid(0) ! Dec 15 (0 sec) else - t1 = daycal(month-1) + daymid(month-1) ! midpoint, previous month + t1 = daycal(mmonth-1) + daymid(mmonth-1) ! midpoint, previous month endif else ! second half of month - t1 = daycal(month) + daymid(month) ! midpoint, current month - t2 = daycal(month+1) + daymid(month+1)! day 15 of next month (0 sec) + t1 = daycal(mmonth) + daymid(mmonth) ! midpoint, current month + t2 = daycal(mmonth+1) + daymid(mmonth+1)! day 15 of next month (0 sec) + endif + + if (tt < t1 .or. tt > t2) then + write(nu_diag,*) subname,' ERROR in tt',tt,t1,t2 + call abort_ice (error_message=subname//' ERROR in tt', & + file=__FILE__, line=__LINE__) endif ! Compute coefficients @@ -1282,8 +1346,7 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) ! local variables real (kind=dbl_kind) :: & - secday, & ! seconds in a day - secyr ! seconds in a year + secday ! seconds in a day real (kind=dbl_kind) :: & tt , & ! seconds elapsed in current year @@ -1292,13 +1355,15 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) character(len=*), parameter :: subname = '(interp_coeff)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - secyr = dayyr * secday ! seconds in a year - tt = mod(ftime,secyr) + ! compute seconds since Jan 1, 00h, yday is the day counter for the year + tt = real(yday-1,kind=dbl_kind)*secday + real(msec,kind=dbl_kind) ! Find neighboring times rcnum = real(recnum,kind=dbl_kind) @@ -1322,6 +1387,12 @@ subroutine interp_coeff (recnum, recslot, secint, dataloc) c1intp = abs((t2 - tt) / (t2 - t1)) c2intp = c1 - c1intp + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg yday,sec = ',yday,msec + write(nu_diag,*) subname,'fdbg tt = ',tt + write(nu_diag,*) subname,'fdbg c12intp = ',c1intp,c2intp + endif + end subroutine interp_coeff !======================================================================= @@ -1335,6 +1406,9 @@ subroutine interp_coeff2 (tt, t1, t2) real (kind=dbl_kind), intent(in) :: & tt , & ! current decimal daynumber t1, t2 ! first+last decimal daynumber + character(len=*), parameter :: subname = '(interp_coeff2)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' ! Compute coefficients c1intp = abs((t2 - tt) / (t2 - t1)) @@ -1364,6 +1438,8 @@ subroutine interpolate_data (field_data, field) character(len=*), parameter :: subname = '(interpolate data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks do j = 1, ny_block @@ -1395,6 +1471,8 @@ subroutine file_year (data_file, yr) character(len=*), parameter :: subname = '(file_year)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (trim(atm_data_type) == 'hadgem') then ! netcdf i = index(data_file,'.nc') - 5 tmpname = data_file @@ -1481,6 +1559,8 @@ subroutine prepare_forcing (nx_block, ny_block, & character(len=*), parameter :: subname = '(prepare_forcing)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, puny_out=puny) call icepack_query_parameters(secday_out=secday) call icepack_query_parameters(calc_strair_out=calc_strair) @@ -1579,7 +1659,7 @@ subroutine prepare_forcing (nx_block, ny_block, & ! convert precipitation units to kg/m^2 s if (trim(precip_units) == 'mm_per_month') then - precip_factor = c12/(secday*days_per_year) + precip_factor = c12/(secday*real(days_per_year,kind=dbl_kind)) elseif (trim(precip_units) == 'mm_per_day') then precip_factor = c1/secday elseif (trim(precip_units) == 'mm_per_sec' .or. & @@ -1699,6 +1779,8 @@ subroutine longwave_parkinson_washington(Tair, cldf, flw) character(len=*), parameter :: subname = '(longwave_parkinson_washington)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, & stefan_boltzmann_out=stefan_boltzmann) call icepack_warnings_flush(nu_diag) @@ -1749,6 +1831,8 @@ subroutine longwave_rosati_miyakoda(cldf, Tsfc, & character(len=*), parameter :: subname = '(longwave_rosati_miyakoda)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, & stefan_boltzmann_out=stefan_boltzmann, & emissivity_out=emissivity) @@ -1786,6 +1870,8 @@ subroutine ncar_files (yr) character(len=*), parameter :: subname = '(ncar_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/MONTHLY/swdn.1996.dat' call file_year(fsw_file,yr) @@ -1857,6 +1943,8 @@ subroutine ncar_data character(len=*), parameter :: subname = '(ncar_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -1870,12 +1958,12 @@ subroutine ncar_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -1892,29 +1980,29 @@ subroutine ncar_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. if (trim(atm_data_format) == 'bin') then - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, fsw_file, fsw_data, & field_loc_center, field_type_scalar) - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, flw_file, cldf_data, & field_loc_center, field_type_scalar) - call read_data (readm, 0, fyear, ixm, month, ixp, & + call read_data (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rain_file, fsnow_data, & field_loc_center, field_type_scalar) else call abort_ice (error_message=subname//'nonbinary atm_data_format unavailable', & file=__FILE__, line=__LINE__) ! The routine exists, for example: -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, fsw_file, 'fsw', fsw_data, & ! field_loc_center, field_type_scalar) -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, flw_file, 'cldf',cldf_data, & ! field_loc_center, field_type_scalar) -! call read_data_nc (readm, 0, fyear, ixm, month, ixp, & +! call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & ! maxrec, rain_file,'prec',fsnow_data, & ! field_loc_center, field_type_scalar) endif @@ -1937,7 +2025,7 @@ subroutine ncar_data maxrec = 1460 ! 365*4 ! current record number - recnum = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec6hr) + recnum = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec6hr) ! Compute record numbers for surrounding data @@ -2009,6 +2097,8 @@ subroutine LY_files (yr) character(len=*), parameter :: subname = '(LY_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + flw_file = & trim(atm_data_dir)//'/MONTHLY/cldf.omip.dat' @@ -2044,6 +2134,9 @@ subroutine LY_files (yr) endif ! master_task end subroutine LY_files + +!======================================================================= + subroutine JRA55_gx1_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2051,6 +2144,8 @@ subroutine JRA55_gx1_files(yr) character(len=*), parameter :: subname = '(JRA55_gx1_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_2005.nc' call file_year(uwind_file,yr) @@ -2060,6 +2155,9 @@ subroutine JRA55_gx1_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_gx1_files + +!======================================================================= + subroutine JRA55_tx1_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2067,6 +2165,8 @@ subroutine JRA55_tx1_files(yr) character(len=*), parameter :: subname = '(JRA55_tx1_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_03hr_forcing_tx1_2005.nc' call file_year(uwind_file,yr) @@ -2076,6 +2176,9 @@ subroutine JRA55_tx1_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_tx1_files + +!======================================================================= + subroutine JRA55_gx3_files(yr) ! integer (kind=int_kind), intent(in) :: & @@ -2083,6 +2186,8 @@ subroutine JRA55_gx3_files(yr) character(len=*), parameter :: subname = '(JRA55_gx3_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + uwind_file = & trim(atm_data_dir)//'/8XDAILY/JRA55_gx3_03hr_forcing_2005.nc' call file_year(uwind_file,yr) @@ -2092,6 +2197,7 @@ subroutine JRA55_gx3_files(yr) write (nu_diag,*) trim(uwind_file) endif end subroutine JRA55_gx3_files + !======================================================================= ! ! read Large and Yeager atmospheric data @@ -2131,6 +2237,8 @@ subroutine LY_data character(len=*), parameter :: subname = '(LY_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) @@ -2145,12 +2253,12 @@ subroutine LY_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -2167,11 +2275,11 @@ subroutine LY_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & flw_file, cldf_data, field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & rain_file, fsnow_data, field_loc_center, field_type_scalar) call interpolate_data (cldf_data, cldf) @@ -2190,7 +2298,7 @@ subroutine LY_data maxrec = 1460 ! 365*4 ! current record number - recnum = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec6hr) + recnum = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec6hr) ! Compute record numbers for surrounding data (2 on each side) @@ -2278,7 +2386,7 @@ subroutine LY_data ! Save record number oldrecnum = recnum - if (dbug) then + if (forcing_diag) then if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' vmin = global_minval(fsw,distrb_info,tmask) @@ -2310,13 +2418,13 @@ subroutine LY_data if (my_task.eq.master_task) & write (nu_diag,*) 'Qa',vmin,vmax - endif ! dbug + endif ! forcing_diag end subroutine LY_data !======================================================================= - subroutine JRA55_data (yr) + subroutine JRA55_data use ice_blocks, only: block, get_block use ice_global_reductions, only: global_minval, global_maxval @@ -2324,34 +2432,34 @@ subroutine JRA55_data (yr) use ice_flux, only: fsnow, Tair, uatm, vatm, Qa, fsw, flw use ice_grid, only: hm, tlon, tlat, tmask, umask use ice_state, only: aice - use ice_calendar, only: days_per_year, use_leap_years + use ice_calendar, only: days_per_year - integer (kind=int_kind), intent(in) :: & - yr ! current forcing year - - integer (kind=int_kind) :: & + integer (kind=int_kind) :: & ncid , & ! netcdf file id - i, j, n1, iblk, & - yrp , & ! year after yr in forcing cycle + i, j, n1 , & + lfyear , & ! local year value recnum , & ! record number maxrec , & ! maximum record number - recslot , & ! spline slot for current record - dataloc ! = 1 for data located in middle of time interval - ! = 2 for date located at end of time interval + iblk ! block index + + integer (kind=int_kind), save :: & + frec_info(2,2) = -99 ! remember prior values to reduce reading + ! first dim is yr, recnum + ! second dim is data1 data2 real (kind=dbl_kind) :: & sec3hr , & ! number of seconds in 3 hours secday , & ! number of seconds in day - eps, tt , & ! interpolation coeff calc + eps, tt , & ! for interpolation coefficients Tffresh , & vmin, vmax - logical (kind=log_kind) :: debug_n_d = .false. - - character (char_len_long) :: uwind_file_old character(len=64) :: fieldname !netcdf field name + character (char_len_long) :: uwind_file_old character(len=*), parameter :: subname = '(JRA55_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) @@ -2359,54 +2467,52 @@ subroutine JRA55_data (yr) file=__FILE__, line=__LINE__) sec3hr = secday/c8 ! seconds in 3 hours - maxrec = days_per_year*8 + maxrec = days_per_year * 8 - if (debug_n_d .and. my_task == master_task) then - write (nu_diag,*) subname,'recnum',recnum - write (nu_diag,*) subname,'maxrec',maxrec - write (nu_diag,*) subname,'days_per_year', days_per_year + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg dpy, maxrec = ',days_per_year,maxrec endif !------------------------------------------------------------------- ! 3-hourly data ! states are instantaneous, 1st record is 00z Jan 1 ! fluxes are 3 hour averages, 1st record is 00z-03z Jan 1 - ! Both states and fluxes have 1st record defined as 00z Jan 1 ! interpolate states, do not interpolate fluxes - ! fluxes are held constant from [init period, end period) !------------------------------------------------------------------- ! File is NETCDF with winds in NORTH and EAST direction ! file variable names are: - ! glbrad (shortwave W/m^2) - ! dlwsfc (longwave W/m^2) - ! wndewd (eastward wind m/s) - ! wndnwd (northward wind m/s) - ! airtmp (air temperature K) - ! spchmd (specific humidity kg/kg) - ! ttlpcp (precipitation kg/m s-1) + ! glbrad (shortwave W/m^2), 3 hr average + ! dlwsfc (longwave W/m^2), 3 hr average + ! wndewd (eastward wind m/s), instantaneous + ! wndnwd (northward wind m/s), instantaneous + ! airtmp (air temperature K), instantaneous + ! spchmd (specific humidity kg/kg), instantaneous + ! ttlpcp (precipitation kg/m s-1), 3 hr average !------------------------------------------------------------------- uwind_file_old = uwind_file - call file_year(uwind_file,yr) if (uwind_file /= uwind_file_old .and. my_task == master_task) then write(nu_diag,*) subname,' reading forcing file = ',trim(uwind_file) endif call ice_open_nc(uwind_file,ncid) - do n1 = 1,2 + do n1 = 1, 2 + lfyear = fyear + call file_year(uwind_file,lfyear) if (n1 == 1) then - recnum = 8*int(yday) - 7 + int(real(sec,kind=dbl_kind)/sec3hr) + recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) if (my_task == master_task .and. (recnum <= 2 .or. recnum >= maxrec-1)) then write(nu_diag,*) subname,' reading forcing file 1st ts = ',trim(uwind_file) endif elseif (n1 == 2) then - recnum = 8*int(yday) - 7 + int(real(sec,kind=dbl_kind)/sec3hr) + 1 + recnum = 8*int(yday) - 7 + int(real(msec,kind=dbl_kind)/sec3hr) + 1 if (recnum > maxrec) then - yrp = fyear_init + mod(nyr,ycycle) ! next year + lfyear = fyear + 1 ! next year + if (lfyear > fyear_final) lfyear = fyear_init recnum = 1 - call file_year(uwind_file,yrp) + call file_year(uwind_file,lfyear) if (my_task == master_task) then write(nu_diag,*) subname,' reading forcing file 2nd ts = ',trim(uwind_file) endif @@ -2415,58 +2521,79 @@ subroutine JRA55_data (yr) endif endif - if (debug_n_d .and. my_task == master_task) then - write(nu_diag,*) subname,' read recnum = ',recnum,n1 + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg read recnum = ',recnum,n1 endif - fieldname = 'airtmp' - call ice_read_nc(ncid,recnum,fieldname,Tair_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) + ! to reduce reading, check whether it's the same data as last read - fieldname = 'wndewd' - call ice_read_nc(ncid,recnum,fieldname,uatm_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) + if (lfyear /= frec_info(1,n1) .or. recnum /= frec_info(2,n1)) then - fieldname = 'wndnwd' - call ice_read_nc(ncid,recnum,fieldname,vatm_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'spchmd' - call ice_read_nc(ncid,recnum,fieldname,Qa_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - ! only read one timestep for fluxes, 3 hr average, no interpolation - if (n1 == 1) then - fieldname = 'glbrad' - call ice_read_nc(ncid,recnum,fieldname,fsw_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'dlwsfc' - call ice_read_nc(ncid,recnum,fieldname,flw_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - - fieldname = 'ttlpcp' - call ice_read_nc(ncid,recnum,fieldname,fsnow_data(:,:,n1,:),debug_n_d, & - field_loc=field_loc_center, & - field_type=field_type_scalar) - endif + ! check whether we can copy values from 2 to 1, should be faster than reading + ! can only do this from 2 to 1 or 1 to 2 without setting up a temporary + ! it's more likely that the values from data2 when time advances are needed in data1 + ! compare n1=1 year/record with data from last timestep at n1=2 - enddo + if (n1 == 1 .and. lfyear == frec_info(1,2) .and. recnum == frec_info(2,2)) then + Tair_data(:,:,1,:) = Tair_data(:,:,2,:) + uatm_data(:,:,1,:) = uatm_data(:,:,2,:) + vatm_data(:,:,1,:) = vatm_data(:,:,2,:) + Qa_data(:,:,1,:) = Qa_data(:,:,2,:) + fsw_data(:,:,1,:) = fsw_data(:,:,2,:) + flw_data(:,:,1,:) = flw_data(:,:,2,:) + fsnow_data(:,:,1,:) = fsnow_data(:,:,2,:) + else + + fieldname = 'airtmp' + call ice_read_nc(ncid,recnum,fieldname,Tair_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'wndewd' + call ice_read_nc(ncid,recnum,fieldname,uatm_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'wndnwd' + call ice_read_nc(ncid,recnum,fieldname,vatm_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'spchmd' + call ice_read_nc(ncid,recnum,fieldname,Qa_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'glbrad' + call ice_read_nc(ncid,recnum,fieldname,fsw_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'dlwsfc' + call ice_read_nc(ncid,recnum,fieldname,flw_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + + fieldname = 'ttlpcp' + call ice_read_nc(ncid,recnum,fieldname,fsnow_data(:,:,n1,:),forcing_debug, & + field_loc=field_loc_center, & + field_type=field_type_scalar) + endif ! copy data from n1=2 from last timestep to n1=1 + endif ! input data is same as last timestep + + frec_info(1,n1) = lfyear + frec_info(2,n1) = recnum + + enddo ! n1 call ice_close_nc(ncid) ! reset uwind_file to original year - call file_year(uwind_file,yr) + call file_year(uwind_file,fyear) ! Compute interpolation coefficients eps = 1.0e-6 - tt = real(mod(sec,nint(sec3hr)),kind=dbl_kind) + tt = real(mod(msec,nint(sec3hr)),kind=dbl_kind) c2intp = tt / sec3hr if (c2intp < c0 .and. c2intp > c0-eps) c2intp = c0 if (c2intp > c1 .and. c2intp < c1+eps) c2intp = c1 @@ -2476,8 +2603,8 @@ subroutine JRA55_data (yr) call abort_ice (error_message=subname//' ERROR: c2intp out of range', & file=__FILE__, line=__LINE__) endif - if (debug_n_d .and. my_task == master_task) then - write(nu_diag,*) subname,' c12intp = ',c1intp,c2intp + if (forcing_debug .and. my_task == master_task) then + write(nu_diag,*) subname,'fdbg c12intp = ',c1intp,c2intp endif ! Interpolate @@ -2485,10 +2612,10 @@ subroutine JRA55_data (yr) call interpolate_data (uatm_data, uatm) call interpolate_data (vatm_data, vatm) call interpolate_data (Qa_data, Qa) - ! use 3 hr average for heat flux and precip fields - ! call interpolate_data (fsw_data, fsw) - ! call interpolate_data (flw_data, flw) - ! call interpolate_data (fsnow_data, fsnow) + ! use 3 hr average for heat flux and precip fields, no interpolation +! call interpolate_data (fsw_data, fsw) +! call interpolate_data (flw_data, flw) +! call interpolate_data (fsnow_data, fsnow) fsw(:,:,:) = fsw_data(:,:,1,:) flw(:,:,:) = flw_data(:,:,1,:) fsnow(:,:,:) = fsnow_data(:,:,1,:) @@ -2517,39 +2644,30 @@ subroutine JRA55_data (yr) enddo ! iblk !$OMP END PARALLEL DO - if (debug_n_d .or. dbug) then - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'JRA55_bulk_data' - vmin = global_minval(fsw,distrb_info,tmask) - vmax = global_maxval(fsw,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'fsw',vmin,vmax - vmin = global_minval(flw,distrb_info,tmask) - vmax = global_maxval(flw,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'flw',vmin,vmax - vmin =global_minval(fsnow,distrb_info,tmask) - vmax =global_maxval(fsnow,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'fsnow',vmin,vmax - vmin = global_minval(Tair,distrb_info,tmask) - vmax = global_maxval(Tair,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'Tair',vmin,vmax - vmin = global_minval(uatm,distrb_info,umask) - vmax = global_maxval(uatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'uatm',vmin,vmax - vmin = global_minval(vatm,distrb_info,umask) - vmax = global_maxval(vatm,distrb_info,umask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'vatm',vmin,vmax - vmin = global_minval(Qa,distrb_info,tmask) - vmax = global_maxval(Qa,distrb_info,tmask) - if (my_task.eq.master_task) & - write (nu_diag,*) subname,'Qa',vmin,vmax - - endif ! dbug + if (forcing_diag .or. forcing_debug) then + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg JRA55_bulk_data' + vmin = global_minval(fsw,distrb_info,tmask) + vmax = global_maxval(fsw,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg fsw',vmin,vmax + vmin = global_minval(flw,distrb_info,tmask) + vmax = global_maxval(flw,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg flw',vmin,vmax + vmin =global_minval(fsnow,distrb_info,tmask) + vmax =global_maxval(fsnow,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg fsnow',vmin,vmax + vmin = global_minval(Tair,distrb_info,tmask) + vmax = global_maxval(Tair,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg Tair',vmin,vmax + vmin = global_minval(uatm,distrb_info,umask) + vmax = global_maxval(uatm,distrb_info,umask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg uatm',vmin,vmax + vmin = global_minval(vatm,distrb_info,umask) + vmax = global_maxval(vatm,distrb_info,umask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg vatm',vmin,vmax + vmin = global_minval(Qa,distrb_info,tmask) + vmax = global_maxval(Qa,distrb_info,tmask) + if (my_task.eq.master_task) write (nu_diag,*) subname,'fdbg Qa',vmin,vmax + endif ! forcing_diag end subroutine JRA55_data @@ -2596,6 +2714,8 @@ subroutine compute_shortwave(nx_block, ny_block, & character(len=*), parameter :: subname = '(compute_shortwave)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday, pi_out=pi) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2604,7 +2724,7 @@ subroutine compute_shortwave(nx_block, ny_block, & do j=jlo,jhi do i=ilo,ihi deg2rad = pi/c180 -! solar_time = mod(real(sec,kind=dbl_kind),secday)/c3600 & +! solar_time = mod(real(msec,kind=dbl_kind),secday)/c3600 & ! + c12*sin(p5*TLON(i,j)) ! Convert longitude to range of -180 to 180 for LST calculation @@ -2613,7 +2733,7 @@ subroutine compute_shortwave(nx_block, ny_block, & if (lontmp .gt. c180) lontmp = lontmp - c360 if (lontmp .lt. -c180) lontmp = lontmp + c360 - solar_time = mod(real(sec,kind=dbl_kind),secday)/c3600 & + solar_time = mod(real(msec,kind=dbl_kind),secday)/c3600 & + lontmp/c15 if (solar_time .ge. 24._dbl_kind) solar_time = solar_time - 24._dbl_kind hour_angle = (c12 - solar_time)*pi/c12 @@ -2658,6 +2778,8 @@ subroutine Qa_fixLY(nx_block, ny_block, Tair, Qa) character(len=*), parameter :: subname = '(Qa_fixLY)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh, puny_out=puny) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -2700,6 +2822,8 @@ subroutine hadgem_files (yr) character(len=*), parameter :: subname = '(hadgem_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(calc_strair_out=calc_strair, & calc_Tsfc_out=calc_Tsfc) call icepack_warnings_flush(nu_diag) @@ -2898,6 +3022,8 @@ subroutine hadgem_data character(len=*), parameter :: subname = '(hadgem_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Lsub_out=Lsub) call icepack_query_parameters(calc_strair_out=calc_strair, & calc_Tsfc_out=calc_Tsfc) @@ -2913,12 +3039,12 @@ subroutine hadgem_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -2935,18 +3061,18 @@ subroutine hadgem_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! ----------------------------------------------------------- ! Rainfall and snowfall ! ----------------------------------------------------------- fieldname='rainfall' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rain_file, fieldname, frain_data, & field_loc_center, field_type_scalar) fieldname='snowfall' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, snow_file, fieldname, fsnow_data, & field_loc_center, field_type_scalar) @@ -2961,11 +3087,11 @@ subroutine hadgem_data ! -------------------------------------------------------- fieldname='u_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, uwind_file, fieldname, uatm_data, & field_loc_center, field_type_vector) fieldname='v_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, vwind_file, fieldname, vatm_data, & field_loc_center, field_type_vector) @@ -2980,11 +3106,11 @@ subroutine hadgem_data ! -------------------------------------------------------- fieldname='taux' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, strax_file, fieldname, strax_data, & field_loc_center, field_type_vector) fieldname='tauy' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, stray_file, fieldname, stray_data, & field_loc_center, field_type_vector) @@ -2999,7 +3125,7 @@ subroutine hadgem_data ! -------------------------------------------------- fieldname='wind_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, wind_file, fieldname, wind_data, & field_loc_center, field_type_scalar) @@ -3022,23 +3148,23 @@ subroutine hadgem_data if (calc_Tsfc .or. oceanmixed_ice .or. calc_strair) then fieldname='SW_incoming' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, fsw_file, fieldname, fsw_data, & field_loc_center, field_type_scalar) fieldname='LW_incoming' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, flw_file, fieldname, flw_data, & field_loc_center, field_type_scalar) fieldname='t_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, tair_file, fieldname, Tair_data, & field_loc_center, field_type_scalar) fieldname='rho_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, rhoa_file, fieldname, rhoa_data, & field_loc_center, field_type_scalar) fieldname='q_10' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, humid_file, fieldname, Qa_data, & field_loc_center, field_type_scalar) @@ -3059,7 +3185,7 @@ subroutine hadgem_data ! ------------------------------------------------------ fieldname='sublim' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, sublim_file, fieldname, sublim_data, & field_loc_center, field_type_scalar) @@ -3068,12 +3194,12 @@ subroutine hadgem_data do n = 1, ncat write(fieldname, '(a,i1)') 'topmeltn',n - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, topmelt_file(n), fieldname, topmelt_data(:,:,:,:,n), & field_loc_center, field_type_scalar) write(fieldname, '(a,i1)') 'botmeltn',n - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, botmelt_file(n), fieldname, botmelt_data(:,:,:,:,n), & field_loc_center, field_type_scalar) @@ -3127,6 +3253,8 @@ subroutine monthly_files (yr) character(len=*), parameter :: subname = '(monthly_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + flw_file = & trim(atm_data_dir)//'/MONTHLY/cldf.omip.dat' @@ -3198,6 +3326,8 @@ subroutine monthly_data character(len=*), parameter :: subname = '(monthly_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -3206,12 +3336,12 @@ subroutine monthly_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3228,27 +3358,27 @@ subroutine monthly_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & flw_file, cldf_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & rain_file, fsnow_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & tair_file, Tair_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & humid_file, Qa_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & wind_file, wind_data, & field_loc_center, field_type_scalar) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & strax_file, strax_data, & field_loc_center, field_type_vector) - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & stray_file, stray_data, & field_loc_center, field_type_vector) @@ -3295,7 +3425,7 @@ subroutine monthly_data enddo ! iblk !$OMP END PARALLEL DO - if (dbug) then + if (forcing_diag) then if (my_task == master_task) write (nu_diag,*) 'LY_bulk_data' vmin = global_minval(fsw,distrb_info,tmask) vmax = global_maxval(fsw,distrb_info,tmask) @@ -3330,7 +3460,7 @@ subroutine monthly_data if (my_task.eq.master_task) & write (nu_diag,*) 'Qa',vmin,vmax - endif ! dbug + endif ! forcing_diag end subroutine monthly_data @@ -3377,6 +3507,8 @@ subroutine oned_data character(len=*), parameter :: subname = '(oned_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + diag = .false. ! write diagnostic information if (trim(atm_data_format) == 'nc') then ! read nc file @@ -3452,6 +3584,8 @@ subroutine oned_files character(len=*), parameter :: subname = '(oned_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/hourlysolar_brw1989_5yr.nc' @@ -3517,6 +3651,8 @@ subroutine ocn_data_clim (dt) character(len=*), parameter :: subname = '(ocn_data_clim)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task .and. istep == 1) then if (trim(ocn_data_type)=='clim') then write (nu_diag,*) ' ' @@ -3540,12 +3676,12 @@ subroutine ocn_data_clim (dt) if (trim(ocn_data_type)=='clim') then midmonth = 15 ! data is given on 15th of every month -!!! midmonth = fix(p5 * real(daymo(month))) ! exact middle +!!! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3561,14 +3697,14 @@ subroutine ocn_data_clim (dt) call interp_coeff_monthly (recslot) readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. !------------------------------------------------------------------- ! Read two monthly SSS values and interpolate. ! Note: SSS is restored instantaneously to data. !------------------------------------------------------------------- - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & sss_file, sss_data, & field_loc_center, field_type_scalar) call interpolate_data (sss_data, sss) @@ -3592,7 +3728,7 @@ subroutine ocn_data_clim (dt) !------------------------------------------------------------------- if (trim(ocn_data_type)=='clim') then - call read_clim_data (readm, 0, ixm, month, ixp, & + call read_clim_data (readm, 0, ixm, mmonth, ixp, & sst_file, sst_data, & field_loc_center, field_type_scalar) call interpolate_data (sst_data, sstdat) @@ -3673,6 +3809,8 @@ subroutine ocn_data_ncar_init character(len=*), parameter :: subname = '(ocn_data_ncar_init)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then write (nu_diag,*) 'WARNING: evp_prep calculates surface tilt' @@ -3722,13 +3860,14 @@ subroutine ocn_data_ncar_init do m=1,12 ! Note: netCDF does single to double conversion if necessary - if (n >= 4 .and. n <= 7) then - call ice_read_nc(fid, m, vname(n), work1, dbug, & - field_loc_NEcorner, field_type_vector) - else - call ice_read_nc(fid, m, vname(n), work1, dbug, & +! if (n >= 4 .and. n <= 7) then +! call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & +! field_loc_NEcorner, field_type_vector) +! else + call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) - endif +! endif + ocn_frc_m(:,:,:,n,m) = work1(:,:,:) enddo ! month loop @@ -3750,10 +3889,10 @@ subroutine ocn_data_ncar_init do m=1,12 nrec = nrec + 1 if (n >= 4 .and. n <= 7) then - call ice_read (nu_forcing, nrec, work1, 'rda8', dbug, & + call ice_read (nu_forcing, nrec, work1, 'rda8', forcing_diag, & field_loc_NEcorner, field_type_vector) else - call ice_read (nu_forcing, nrec, work1, 'rda8', dbug, & + call ice_read (nu_forcing, nrec, work1, 'rda8', forcing_diag, & field_loc_center, field_type_scalar) endif ocn_frc_m(:,:,:,n,m) = work1(:,:,:) @@ -3764,8 +3903,8 @@ subroutine ocn_data_ncar_init endif !echmod - currents cause Fram outflow to be too large - ocn_frc_m(:,:,:,4,:) = c0 - ocn_frc_m(:,:,:,5,:) = c0 +! ocn_frc_m(:,:,:,4,:) = c0 +! ocn_frc_m(:,:,:,5,:) = c0 !echmod end subroutine ocn_data_ncar_init @@ -3830,6 +3969,8 @@ subroutine ocn_data_ncar_init_3D character(len=*), parameter :: subname = '(ocn_data_ncar_init_3D)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then write (nu_diag,*) 'WARNING: evp_prep calculates surface tilt' @@ -3882,10 +4023,10 @@ subroutine ocn_data_ncar_init_3D ! Note: netCDF does single to double conversion if necessary if (n == 4 .or. n == 5) then ! 3D currents nzlev = 1 ! surface currents - call ice_read_nc_uv(fid, m, nzlev, vname(n), work1, dbug, & + call ice_read_nc_uv(fid, m, nzlev, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) else - call ice_read_nc(fid, m, vname(n), work1, dbug, & + call ice_read_nc(fid, m, vname(n), work1, forcing_diag, & field_loc_center, field_type_scalar) endif @@ -3967,6 +4108,8 @@ subroutine ocn_data_ncar(dt) character(len=*), parameter :: subname = '(ocn_data_ncar)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -3975,12 +4118,12 @@ subroutine ocn_data_ncar(dt) !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month),kind=dbl_kind)) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth),kind=dbl_kind)) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -3995,19 +4138,18 @@ subroutine ocn_data_ncar(dt) ! Find interpolation coefficients call interp_coeff_monthly (recslot) + sst_data(:,:,:,:) = c0 do n = nfld, 1, -1 - !$OMP PARALLEL DO PRIVATE(iblk,i,j) do iblk = 1, nblocks ! use sst_data arrays as temporary work space until n=1 if (ixm /= -99) then ! first half of month sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,ixm) - sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,month) + sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,mmonth) else ! second half of month - sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,month) + sst_data(:,:,1,iblk) = ocn_frc_m(:,:,iblk,n,mmonth) sst_data(:,:,2,iblk) = ocn_frc_m(:,:,iblk,n,ixp) endif enddo - !$OMP END PARALLEL DO call interpolate_data (sst_data,work1) ! masking by hm is necessary due to NaNs in the data file @@ -4023,7 +4165,7 @@ subroutine ocn_data_ncar(dt) do iblk = 1, nblocks if (hm(i,j,iblk) == c1) then if (n == 2) sss (i,j,iblk) = work1(i,j,iblk) - if (n == 3) hmix (i,j,iblk) = work1(i,j,iblk) + if (n == 3) hmix (i,j,iblk) = max(mixed_layer_depth_default,work1(i,j,iblk)) if (n == 4) uocn (i,j,iblk) = work1(i,j,iblk) if (n == 5) vocn (i,j,iblk) = work1(i,j,iblk) if (n == 6) ss_tltx(i,j,iblk) = work1(i,j,iblk) @@ -4071,7 +4213,7 @@ subroutine ocn_data_ncar(dt) !$OMP END PARALLEL DO endif - if (dbug) then + if (forcing_diag) then if (my_task == master_task) & write (nu_diag,*) 'ocn_data_ncar' vmin = global_minval(Tf,distrb_info,tmask) @@ -4125,6 +4267,8 @@ subroutine ocn_data_oned character(len=*), parameter :: subname = '(ocn_data_oned)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + sss (:,:,:) = 34.0_dbl_kind ! sea surface salinity (ppt) call ocn_freezing_temperature @@ -4136,7 +4280,7 @@ subroutine ocn_data_oned ss_tlty(:,:,:) = c0 frzmlt (:,:,:) = c0 ! freezing/melting potential (W/m^2) qdp (:,:,:) = c0 ! deep ocean heat flux (W/m^2) - hmix (:,:,:) = c20 ! ocean mixed layer depth + hmix (:,:,:) = mixed_layer_depth_default ! ocean mixed layer depth end subroutine ocn_data_oned @@ -4180,6 +4324,8 @@ subroutine ocn_data_hadgem(dt) character(len=*), parameter :: subname = '(ocn_data_hadgem)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + !------------------------------------------------------------------- ! monthly data ! @@ -4188,12 +4334,12 @@ subroutine ocn_data_hadgem(dt) !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -4210,7 +4356,7 @@ subroutine ocn_data_hadgem(dt) ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. if (my_task == master_task .and. istep == 1) then write (nu_diag,*) ' ' @@ -4231,7 +4377,7 @@ subroutine ocn_data_hadgem(dt) ! ----------------------------------------------------------- sst_file = trim(ocn_data_dir)//'/MONTHLY/sst.1997.nc' fieldname='sst' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, sst_file, fieldname, sst_data, & field_loc_center, field_type_scalar) @@ -4265,7 +4411,7 @@ subroutine ocn_data_hadgem(dt) filename = trim(ocn_data_dir)//'/MONTHLY/uocn.1997.nc' fieldname='uocn' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, filename, fieldname, uocn_data, & field_loc_center, field_type_vector) @@ -4274,7 +4420,7 @@ subroutine ocn_data_hadgem(dt) filename = trim(ocn_data_dir)//'/MONTHLY/vocn.1997.nc' fieldname='vocn' - call read_data_nc (readm, 0, fyear, ixm, month, ixp, & + call read_data_nc (readm, 0, fyear, ixm, mmonth, ixp, & maxrec, filename, fieldname, vocn_data, & field_loc_center, field_type_vector) @@ -4334,6 +4480,10 @@ subroutine ocn_data_hycom_init character (char_len) :: & fieldname ! field name in netcdf file + character(len=*), parameter :: subname = '(ocn_data_hycom_init)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (trim(ocn_data_type) == 'hycom') then sss_file = trim(ocn_data_dir)//'ice.restart.surf.nc' @@ -4344,7 +4494,7 @@ subroutine ocn_data_hycom_init fieldname = 'sss' call ice_open_nc (sss_file, fid) - call ice_read_nc (fid, 1 , fieldname, sss, dbug, & + call ice_read_nc (fid, 1 , fieldname, sss, forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) @@ -4359,7 +4509,7 @@ subroutine ocn_data_hycom_init fieldname = 'sst' call ice_open_nc (sst_file, fid) - call ice_read_nc (fid, 1 , fieldname, sst, dbug, & + call ice_read_nc (fid, 1 , fieldname, sst, forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) @@ -4387,6 +4537,9 @@ subroutine hycom_atm_files fid ! File id character (char_len) :: & varname ! variable name in netcdf file + character(len=*), parameter :: subname = '(hycom_atm_files)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' fsw_file = trim(atm_data_dir)//'/forcing.shwflx.nc' flw_file = trim(atm_data_dir)//'/forcing.radflx.nc' @@ -4430,7 +4583,6 @@ subroutine hycom_atm_data use ice_flux, only: fsw, fsnow, Tair, uatm, vatm, Qa, flw use ice_domain, only: nblocks - use ice_calendar, only: year_init integer (kind=int_kind) :: & recnum ! record number @@ -4450,11 +4602,13 @@ subroutine hycom_atm_data character(len=*), parameter :: subname = '(hycom_atm_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(Tffresh_out=Tffresh) call icepack_query_parameters(secday_out=secday) - ! current time in HYCOM jday units - hcdate = hc_jday(nyr+year_init-1,0,0)+ yday+sec/secday + ! current time in HYCOM jday units (HYCOM ref year: 1900,12,31,000000) + hcdate = real(compute_days_between(1900,12,31,myear,mmonth,mday)) + msec/secday ! Init recnum try recnum=min(max(oldrecnum,1),Njday_atm-1) @@ -4477,7 +4631,7 @@ subroutine hycom_atm_data write (nu_diag,*) & 'ERROR: CICE: Atm forcing not available at hcdate =',hcdate write (nu_diag,*) & - 'ERROR: CICE: nyr, year_init, yday ,sec = ',nyr, year_init, yday, sec + 'ERROR: CICE: myear, yday ,msec = ',myear, yday, msec call abort_ice ('ERROR: CICE stopped') endif @@ -4528,7 +4682,7 @@ subroutine hycom_atm_data endif ! Interpolate - if (dbug) then + if (forcing_diag) then if (my_task == master_task) then write(nu_diag,*)'CICE: Atm. interpolate: = ',& hcdate,c1intp,c2intp @@ -4581,7 +4735,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & ! data is missing, and we assume periodicity when monthly data ! is missing. ! - use ice_diagnostics, only: check_step + use ice_diagnostics, only: debug_model_step logical (kind=log_kind), intent(in) :: flag @@ -4605,8 +4759,6 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & real (kind=dbl_kind), dimension(2), intent(inout) :: & field_data ! 2 values needed for interpolation - character(len=*), parameter :: subname = '(read_data_nc_point)' - integer (kind=int_kind) :: & nrec , & ! record number to read n2, n4 , & ! like ixm and ixp, but @@ -4614,13 +4766,17 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & arg , & ! value of time argument in field_data fid ! file id for netCDF routines + character(len=*), parameter :: subname = '(read_data_nc_point)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_readwrite) ! reading/writing field_data = c0 ! to satisfy intent(out) attribute - if (istep1 > check_step) dbug = .true. !! debugging + if (istep1 > debug_model_step) forcing_diag = .true. !! debugging - if (my_task==master_task .and. (dbug)) then + if (my_task==master_task .and. (forcing_diag)) then write(nu_diag,*) ' ', trim(data_file) endif @@ -4667,7 +4823,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n2 call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) !if (ixx==1) call ice_close_nc(fid) @@ -4682,7 +4838,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + ixx call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) if (ixp /= -99) then @@ -4708,7 +4864,7 @@ subroutine read_data_nc_point (flag, recd, yr, ixm, ixx, ixp, & nrec = recd + n4 call ice_read_nc & - (fid, nrec, fieldname, field_data(arg), dbug, & + (fid, nrec, fieldname, field_data(arg), forcing_diag, & field_loc, field_type) endif ! ixp /= -99 @@ -4726,6 +4882,8 @@ subroutine ISPOL_files character(len=*), parameter :: subname = '(ISPOL_files)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + fsw_file = & trim(atm_data_dir)//'/fsw_sfc_4Xdaily.nc' @@ -4817,6 +4975,8 @@ subroutine ISPOL_data character(len=*), parameter :: subname = '(ISPOL_data)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -4914,7 +5074,7 @@ subroutine ISPOL_data maxrec = 1460 ! 366*4 ! current record number - recnum4X = 4*int(yday) - 3 + int(real(sec,kind=dbl_kind)/sec1hr) + recnum4X = 4*int(yday) - 3 + int(real(msec,kind=dbl_kind)/sec1hr) ! Compute record numbers for surrounding data (2 on each side) ixm = mod(recnum4X+maxrec-2,maxrec) + 1 @@ -5015,6 +5175,8 @@ subroutine ocn_data_ispol_init character(len=*), parameter :: subname = '(ocn_data_ispol_init)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + if (my_task == master_task) then if (restore_ocn) write (nu_diag,*) & @@ -5040,10 +5202,10 @@ subroutine ocn_data_ispol_init do m=1,12 ! Note: netCDF does single to double conversion if necessary if (n >= 4 .and. n <= 7) then - call ice_read_nc(fid, m, vname(n), work, dbug, & + call ice_read_nc(fid, m, vname(n), work, forcing_diag, & field_loc_NEcorner, field_type_vector) else - call ice_read_nc(fid, m, vname(n), work, dbug, & + call ice_read_nc(fid, m, vname(n), work, forcing_diag, & field_loc_center, field_type_scalar) endif ocn_frc_m(:,:,:,n,m) = work @@ -5074,6 +5236,7 @@ subroutine box2001_data use ice_domain, only: nblocks use ice_domain_size, only: max_blocks + use ice_calendar, only: timesecs use ice_blocks, only: nx_block, ny_block, nghost use ice_flux, only: uocn, vocn, uatm, vatm, wind, rhoa, strax, stray use ice_grid, only: uvm, to_ugrid @@ -5089,6 +5252,11 @@ subroutine box2001_data real (kind=dbl_kind) :: & secday, pi , puny, period, pi2, tau + + character(len=*), parameter :: subname = '(box2001_data)' + + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call icepack_query_parameters(pi_out=pi, pi2_out=pi2, puny_out=puny) call icepack_query_parameters(secday_out=secday) @@ -5111,12 +5279,12 @@ subroutine box2001_data vocn(i,j,iblk) = vocn(i,j,iblk) * uvm(i,j,iblk) ! wind components - uatm(i,j,iblk) = c5 + (sin(pi2*time/period)-c3) & + uatm(i,j,iblk) = c5 + (sin(pi2*timesecs/period)-c3) & * sin(pi2*real(i-nghost, kind=dbl_kind) & /real(nx_global,kind=dbl_kind)) & * sin(pi *real(j-nghost, kind=dbl_kind) & /real(ny_global,kind=dbl_kind)) - vatm(i,j,iblk) = c5 + (sin(pi2*time/period)-c3) & + vatm(i,j,iblk) = c5 + (sin(pi2*timesecs/period)-c3) & * sin(pi *real(i-nghost, kind=dbl_kind) & /real(nx_global,kind=dbl_kind)) & * sin(pi2*real(j-nghost, kind=dbl_kind) & @@ -5180,6 +5348,8 @@ subroutine get_wave_spec logical (kind=log_kind) :: wave_spec character(len=*), parameter :: subname = '(get_wave_spec)' + if (forcing_debug .and. my_task == master_task) write(nu_diag,*) subname,'fdbg start' + call ice_timer_start(timer_fsd) call icepack_query_parameters(wave_spec_out=wave_spec, & @@ -5191,7 +5361,7 @@ subroutine get_wave_spec ! if no wave data is provided, wave_spectrum is zero everywhere wave_spectrum(:,:,:,:) = c0 wave_spec_dir = ocn_data_dir - dbug = .false. + forcing_diag = .false. ! wave spectrum and frequencies if (wave_spec) then @@ -5209,7 +5379,7 @@ subroutine get_wave_spec else #ifdef USE_NETCDF call ice_open_nc(wave_spec_file,fid) - call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), dbug, & + call ice_read_nc_xyf (fid, 1, 'efreq', wave_spectrum(:,:,:,:), forcing_diag, & field_loc_center, field_type_scalar) call ice_close_nc(fid) #else diff --git a/cicecore/cicedynB/general/ice_forcing_bgc.F90 b/cicecore/cicedynB/general/ice_forcing_bgc.F90 index e5ef851fa..d9408c304 100644 --- a/cicecore/cicedynB/general/ice_forcing_bgc.F90 +++ b/cicecore/cicedynB/general/ice_forcing_bgc.F90 @@ -14,7 +14,7 @@ module ice_forcing_bgc use ice_blocks, only: nx_block, ny_block use ice_domain_size, only: max_blocks use ice_communicate, only: my_task, master_task - use ice_calendar, only: dt, istep, sec, mday, month + use ice_calendar, only: dt, istep, msec, mday, mmonth use ice_fileunits, only: nu_diag use ice_arrays_column, only: restore_bgc, & bgc_data_dir, fe_data_type @@ -163,12 +163,12 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -!!! midmonth = fix(p5 * real(daymo(month))) ! exact middle +!!! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -184,7 +184,7 @@ subroutine get_forcing_bgc call interp_coeff_monthly (recslot) readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. endif ! 'clim prep' @@ -194,11 +194,11 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- if (trim(bgc_data_type)=='clim' .AND. tr_bgc_Sil) then - ! call read_clim_data (readm, 0, ixm, month, ixp, & + ! call read_clim_data (readm, 0, ixm, mmonth, ixp, & ! sil_file, sil_data, & ! field_loc_center, field_type_scalar) fieldname = 'silicate' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & sil_file, fieldname, sil_data, & field_loc_center, field_type_scalar) call interpolate_data (sil_data, sildat) @@ -276,11 +276,11 @@ subroutine get_forcing_bgc !------------------------------------------------------------------- if (trim(bgc_data_type)=='clim' .AND. tr_bgc_Nit) then - ! call read_clim_data (readm, 0, ixm, month, ixp, & + ! call read_clim_data (readm, 0, ixm, mmonth, ixp, & ! nit_file, nit_data, & ! field_loc_center, field_type_scalar) fieldname = 'nitrate' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & nit_file, fieldname, nit_data, & field_loc_center, field_type_scalar) call interpolate_data (nit_data, nitdat) @@ -584,7 +584,7 @@ end subroutine faero_default subroutine faero_data - use ice_calendar, only: month, mday, istep, sec + use ice_calendar, only: mmonth, mday, istep, msec use ice_domain_size, only: max_blocks use ice_blocks, only: nx_block, ny_block use ice_flux_bgc, only: faero_atm @@ -625,12 +625,12 @@ subroutine faero_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = 99 ! other two points will be used if (mday < midmonth) ixp = 99 @@ -647,23 +647,23 @@ subroutine faero_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! aero_file = trim(atm_data_dir)//'faero.nc' aero_file = '/usr/projects/climate/eclare/DATA/gx1v3/faero.nc' fieldname='faero_atm001' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero1_data, & field_loc_center, field_type_scalar) fieldname='faero_atm002' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero2_data, & field_loc_center, field_type_scalar) fieldname='faero_atm003' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero3_data, & field_loc_center, field_type_scalar) @@ -727,12 +727,12 @@ subroutine fzaero_data !------------------------------------------------------------------- midmonth = 15 ! data is given on 15th of every month -! midmonth = fix(p5 * real(daymo(month))) ! exact middle +! midmonth = fix(p5 * real(daymo(mmonth))) ! exact middle ! Compute record numbers for surrounding months maxrec = 12 - ixm = mod(month+maxrec-2,maxrec) + 1 - ixp = mod(month, maxrec) + 1 + ixm = mod(mmonth+maxrec-2,maxrec) + 1 + ixp = mod(mmonth, maxrec) + 1 if (mday >= midmonth) ixm = -99 ! other two points will be used if (mday < midmonth) ixp = -99 @@ -749,14 +749,14 @@ subroutine fzaero_data ! Read 2 monthly values readm = .false. - if (istep==1 .or. (mday==midmonth .and. sec==0)) readm = .true. + if (istep==1 .or. (mday==midmonth .and. msec==0)) readm = .true. ! aero_file = trim(atm_data_dir)//'faero.nc' ! Cam5 monthly total black carbon deposition on the gx1 grid" aero_file = '/usr/projects/climate/njeffery/DATA/CAM/Hailong_Wang/Cam5_bc_monthly_popgrid.nc' fieldname='bcd' - call read_clim_data_nc (readm, 0, ixm, month, ixp, & + call read_clim_data_nc (readm, 0, ixm, mmonth, ixp, & aero_file, fieldname, aero_data, & field_loc_center, field_type_scalar) diff --git a/cicecore/cicedynB/general/ice_init.F90 b/cicecore/cicedynB/general/ice_init.F90 index b59a93862..5e5fd144f 100644 --- a/cicecore/cicedynB/general/ice_init.F90 +++ b/cicecore/cicedynB/general/ice_init.F90 @@ -58,16 +58,18 @@ module ice_init subroutine input_data use ice_broadcast, only: broadcast_scalar, broadcast_array - use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt + use ice_diagnostics, only: diag_file, print_global, print_points, latpnt, lonpnt, & + debug_model, debug_model_step use ice_domain, only: close_boundaries, orca_halogrid use ice_domain_size, only: ncat, nilyr, nslyr, nblyr, nfsd, nfreq, & n_iso, n_aero, n_zaero, n_algae, & n_doc, n_dic, n_don, n_fed, n_fep, & max_nstrm - use ice_calendar, only: year_init, istep0, histfreq, histfreq_n, & + use ice_calendar, only: year_init, month_init, day_init, sec_init, & + istep0, histfreq, histfreq_n, & dumpfreq, dumpfreq_n, diagfreq, & npt, dt, ndtd, days_per_year, use_leap_years, & - write_ic, dump_last + write_ic, dump_last, npt_unit 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, & @@ -82,7 +84,7 @@ subroutine input_data use ice_flux, only: default_season use ice_flux_bgc, only: cpl_bgc use ice_forcing, only: & - ycycle, fyear_init, dbug, & + ycycle, fyear_init, forcing_diag, & atm_data_type, atm_data_dir, precip_units, rotate_wind, & atm_data_format, ocn_data_format, & bgc_data_type, & @@ -125,7 +127,7 @@ 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 + sw_frac, sw_dtemp, floediam, hfrazilmin, iceruf integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, natmiter, & kitd, kcatbound, ktransport @@ -154,7 +156,7 @@ subroutine input_data !----------------------------------------------------------------- namelist /setup_nml/ & - days_per_year, use_leap_years, year_init, istep0, & + days_per_year, use_leap_years, istep0, npt_unit, & dt, npt, ndtd, numin, & runtype, runid, bfbflag, numax, & ice_ic, restart, restart_dir, restart_file, & @@ -162,9 +164,10 @@ subroutine input_data pointer_file, dumpfreq, dumpfreq_n, dump_last, & diagfreq, diag_type, diag_file, history_format,& print_global, print_points, latpnt, lonpnt, & - dbug, histfreq, histfreq_n, hist_avg, & + forcing_diag, histfreq, histfreq_n, hist_avg, & history_dir, history_file, history_precision, cpl_bgc, & - conserv_check, & + conserv_check, debug_model, debug_model_step, & + year_init, month_init, day_init, sec_init, & write_ic, incond_dir, incond_file, version_name namelist /grid_nml/ & @@ -224,7 +227,7 @@ subroutine input_data namelist /forcing_nml/ & formdrag, atmbndy, calc_strair, calc_Tsfc, & highfreq, natmiter, atmiter_conv, & - ustar_min, emissivity, & + ustar_min, emissivity, iceruf, & fbot_xfer_type, update_ocn_f, l_mpond_fresh, tfrz_option, & oceanmixed_ice, restore_ice, restore_ocn, trestore, & precip_units, default_season, wave_spec_type,nfreq, & @@ -250,6 +253,9 @@ subroutine input_data days_per_year = 365 ! number of days in a year use_leap_years= .false.! if true, use leap years (Feb 29) year_init = 0 ! initial year + month_init = 1 ! initial month + day_init = 1 ! initial day + sec_init = 0 ! initial second istep0 = 0 ! no. of steps taken in previous integrations, ! real (dumped) or imagined (to set calendar) #ifndef CESMCOUPLED @@ -258,7 +264,10 @@ subroutine input_data numin = 11 ! min allowed unit number numax = 99 ! max allowed unit number npt = 99999 ! total number of time steps (dt) + npt_unit = '1' ! units of npt 'y', 'm', 'd', 's', '1' diagfreq = 24 ! how often diag output is written + debug_model = .false. ! debug output + debug_model_step = 999999999 ! debug model after this step number print_points = .false. ! if true, print point data print_global = .true. ! if true, print global diagnostic data bfbflag = 'off' ! off = optimized @@ -370,6 +379,7 @@ subroutine input_data calc_Tsfc = .true. ! calculate surface temperature update_ocn_f = .false. ! include fresh water and salt fluxes for frazil ustar_min = 0.005 ! minimum friction velocity for ocean heat flux (m/s) + iceruf = 0.0005_dbl_kind ! ice surface roughness at atmosphere interface (m) emissivity = 0.985 ! emissivity of snow and ice l_mpond_fresh = .false. ! logical switch for including meltpond freshwater ! flux feedback to ocean model @@ -426,7 +436,7 @@ subroutine input_data restore_ocn = .false. ! restore sst if true trestore = 90 ! restoring timescale, days (0 instantaneous) restore_ice = .false. ! restore ice state on grid edges if true - dbug = .false. ! true writes diagnostics for input forcing + forcing_diag = .false. ! true writes diagnostics for input forcing latpnt(1) = 90._dbl_kind ! latitude of diagnostic point 1 (deg) lonpnt(1) = 0._dbl_kind ! longitude of point 1 (deg) @@ -584,10 +594,16 @@ subroutine input_data call broadcast_scalar(days_per_year, master_task) call broadcast_scalar(use_leap_years, master_task) call broadcast_scalar(year_init, master_task) + call broadcast_scalar(month_init, master_task) + call broadcast_scalar(day_init, master_task) + call broadcast_scalar(sec_init, master_task) call broadcast_scalar(istep0, master_task) call broadcast_scalar(dt, master_task) call broadcast_scalar(npt, master_task) + call broadcast_scalar(npt_unit, master_task) call broadcast_scalar(diagfreq, master_task) + call broadcast_scalar(debug_model, master_task) + call broadcast_scalar(debug_model_step, master_task) call broadcast_scalar(print_points, master_task) call broadcast_scalar(print_global, master_task) call broadcast_scalar(bfbflag, master_task) @@ -722,6 +738,7 @@ subroutine input_data call broadcast_scalar(update_ocn_f, master_task) call broadcast_scalar(l_mpond_fresh, master_task) call broadcast_scalar(ustar_min, master_task) + call broadcast_scalar(iceruf, master_task) call broadcast_scalar(emissivity, master_task) call broadcast_scalar(fbot_xfer_type, master_task) call broadcast_scalar(precip_units, master_task) @@ -741,14 +758,12 @@ subroutine input_data call broadcast_scalar(restore_ocn, master_task) call broadcast_scalar(trestore, master_task) call broadcast_scalar(restore_ice, master_task) - call broadcast_scalar(dbug, master_task) + call broadcast_scalar(forcing_diag, master_task) call broadcast_array (latpnt(1:2), master_task) call broadcast_array (lonpnt(1:2), master_task) call broadcast_scalar(runid, master_task) call broadcast_scalar(runtype, master_task) - - if (dbug) & ! else only master_task writes to file - call broadcast_scalar(nu_diag, master_task) + !call broadcast_scalar(nu_diag, master_task) ! tracers call broadcast_scalar(tr_iage, master_task) @@ -1443,6 +1458,7 @@ subroutine input_data tmpstr2 = ' : four constant albedos' else tmpstr2 = ' : unknown value' + abort_list = trim(abort_list)//":23" endif write(nu_diag,1030) ' albedo_type = ', trim(albedo_type),trim(tmpstr2) if (trim(albedo_type) == 'ccsm3') then @@ -1469,6 +1485,7 @@ subroutine input_data write(nu_diag,1010) ' calc_strair = ', calc_strair,' : calculate wind stress and speed' write(nu_diag,1010) ' rotate_wind = ', rotate_wind,' : rotate wind/stress to computational grid' write(nu_diag,1010) ' formdrag = ', formdrag,' : use form drag parameterization' + write(nu_diag,1000) ' iceruf = ', iceruf, ' : ice surface roughness at atmosphere interface (m)' if (trim(atmbndy) == 'default') then tmpstr2 = ' : stability-based boundary layer' write(nu_diag,1010) ' highfreq = ', highfreq,' : high-frequency atmospheric coupling' @@ -1621,11 +1638,17 @@ subroutine input_data write(nu_diag,1031) ' runid = ', trim(runid) write(nu_diag,1031) ' runtype = ', trim(runtype) write(nu_diag,1021) ' year_init = ', year_init + write(nu_diag,1021) ' month_init = ', month_init + write(nu_diag,1021) ' day_init = ', day_init + write(nu_diag,1021) ' sec_init = ', sec_init write(nu_diag,1021) ' istep0 = ', istep0 + write(nu_diag,1031) ' npt_unit = ', trim(npt_unit) write(nu_diag,1021) ' npt = ', npt write(nu_diag,1021) ' diagfreq = ', diagfreq write(nu_diag,1011) ' print_global = ', print_global write(nu_diag,1011) ' print_points = ', print_points + write(nu_diag,1011) ' debug_model = ', debug_model + write(nu_diag,1022) ' debug_model_step = ', debug_model_step write(nu_diag,1031) ' bfbflag = ', trim(bfbflag) write(nu_diag,1021) ' numin = ', numin write(nu_diag,1021) ' numax = ', numax @@ -1785,7 +1808,7 @@ subroutine input_data wave_spec_type_in = wave_spec_type, & 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, & + Pstar_in=Pstar, Cstar_in=Cstar, iceruf_in=iceruf, & 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, & @@ -1806,6 +1829,7 @@ subroutine input_data 1011 format (a20,1x,l6) 1020 format (a20,8x,i6,1x,a) ! integer 1021 format (a20,1x,i6) + 1022 format (a20,1x,i12) 1023 format (a20,1x,6i6) 1030 format (a20,a14,1x,a) ! character 1031 format (a20,1x,a,a) diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index b21908e77..29bfdbf0e 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -12,7 +12,7 @@ module ice_step_mod use ice_kinds_mod - use ice_constants, only: c0, c1, c1000, c4 + use ice_constants, only: c0, c1, c1000, c4, p25 use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -189,18 +189,18 @@ subroutine step_therm1 (dt, iblk) use ice_prescribed_mod, only: prescribed_ice #else logical (kind=log_kind) :: & - prescribed_ice ! if .true., use prescribed ice instead of computed + prescribed_ice ! if .true., use prescribed ice instead of computed #endif real (kind=dbl_kind), intent(in) :: & - dt ! time step + dt ! time step (s) integer (kind=int_kind), intent(in) :: & - iblk ! block index + iblk ! block index ! local variables #ifdef CICE_IN_NEMO real (kind=dbl_kind) :: & - raice ! temporary reverse ice concentration + raice ! reciprocal of ice concentration #endif integer (kind=int_kind) :: & ilo,ihi,jlo,jhi, & ! beginning and end of physical domain @@ -215,24 +215,27 @@ subroutine step_therm1 (dt, iblk) 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 + tr_pond_lvl, tr_pond_topo, calc_Tsfc, highfreq real (kind=dbl_kind) :: & - puny + uvel_center, & ! cell-centered velocity, x component (m/s) + vvel_center, & ! cell-centered velocity, y component (m/s) + puny ! a very small number real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & - aerosno, aeroice ! kg/m^2 + aerosno, aeroice ! kg/m^2 real (kind=dbl_kind), dimension(n_iso,ncat) :: & - isosno, isoice ! kg/m^2 + isosno, isoice ! kg/m^2 type (block) :: & - this_block ! block information for current block + this_block ! block information for current block character(len=*), parameter :: subname = '(step_therm1)' call icepack_query_parameters(puny_out=puny) call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(highfreq_out=highfreq) call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, tr_iso_out=tr_iso, & @@ -289,6 +292,16 @@ subroutine step_therm1 (dt, iblk) do j = jlo, jhi do i = ilo, ihi + if (highfreq) then ! include ice velocity in calculation of wind stress + uvel_center = p25*(uvel(i,j ,iblk) + uvel(i-1,j ,iblk) & ! cell-centered velocity + + uvel(i,j-1,iblk) + uvel(i-1,j-1,iblk)) ! assumes wind components + vvel_center = p25*(vvel(i,j ,iblk) + vvel(i-1,j ,iblk) & ! are also cell-centered + + vvel(i,j-1,iblk) + vvel(i-1,j-1,iblk)) + else + uvel_center = c0 ! not used + vvel_center = c0 + endif ! highfreq + if (tr_iso) then ! trcrn(nt_iso*) has units kg/m^3 do n=1,ncat do k=1,n_iso @@ -324,8 +337,8 @@ subroutine step_therm1 (dt, iblk) vicen = vicen (i,j,:,iblk), & vsno = vsno (i,j, iblk), & vsnon = vsnon (i,j,:,iblk), & - uvel = uvel (i,j, iblk), & - vvel = vvel (i,j, iblk), & + uvel = uvel_center , & + vvel = vvel_center , & Tsfc = trcrn (i,j,nt_Tsfc,:,iblk), & zqsn = trcrn (i,j,nt_qsno:nt_qsno+nslyr-1,:,iblk), & zqin = trcrn (i,j,nt_qice:nt_qice+nilyr-1,:,iblk), & @@ -1026,7 +1039,7 @@ subroutine step_radiation (dt, iblk) kaer_tab, waer_tab, gaer_tab, kaer_bc_tab, waer_bc_tab, & gaer_bc_tab, bcenh, swgrid, igrid use ice_blocks, only: block, get_block - use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, sec + use ice_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, msec use ice_domain, only: blocks_ice use ice_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr use ice_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow @@ -1145,7 +1158,7 @@ subroutine step_radiation (dt, iblk) calendar_type=calendar_type, & days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & - sec=sec, & + sec=msec, & kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 index 884ee6331..635bbbeb4 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_boundary.F90 @@ -41,6 +41,7 @@ module ice_boundary type, public :: ice_halo integer (int_kind) :: & communicator, &! communicator to use for update messages + numLocalBlocks, &! number of local blocks, needed for halo fill numMsgSend, &! number of messages to send halo update numMsgRecv, &! number of messages to recv halo update numLocalCopies, &! num local copies for halo update @@ -50,6 +51,7 @@ module ice_boundary tripoleTFlag ! NS boundary is a tripole T-fold integer (int_kind), dimension(:), pointer :: & + blockGlobalID, &! list of local block global IDs, needed for halo fill recvTask, &! task from which to recv each msg sendTask, &! task to which to send each msg sizeSend, &! size of each sent message @@ -220,6 +222,13 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & cornerMsgSize = nghost*nghost tripoleRows = nghost+1 + !*** store some block info to fill haloes properly + call ice_distributionGet(dist, numLocalBlocks=halo%numLocalBlocks) + if (halo%numLocalBlocks > 0) then + allocate(halo%blockGlobalID(halo%numLocalBlocks)) + call ice_distributionGet(dist, blockGlobalID=halo%blockGlobalID) + endif + if (nsBoundaryType == 'tripole' .or. nsBoundaryType == 'tripoleT') then tripoleTFlag = (nsBoundaryType == 'tripoleT') if (tripoleTflag) tripoleRows = tripoleRows+1 @@ -1023,6 +1032,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) communicator, &! communicator for message passing numMsgSend, numMsgRecv, &! number of messages for this halo numLocalCopies, &! num local copies for halo update + numLocalBlocks, &! num local blocks for halo fill tripoleRows, &! number of rows in tripole buffer lbufSizeSend, &! buffer size for send messages lbufSizeRecv ! buffer size for recv messages @@ -1043,6 +1053,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) numMsgSend = basehalo%numMsgSend numMsgRecv = basehalo%numMsgRecv numLocalCopies = basehalo%numLocalCopies + numLocalBlocks = basehalo%numLocalBlocks lbufSizeSend = size(basehalo%sendAddr,dim=2) lbufSizeRecv = size(basehalo%recvAddr,dim=2) @@ -1056,6 +1067,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%recvAddr(3,lbufSizeRecv,numMsgRecv), & halo%srcLocalAddr(3,numLocalCopies), & halo%dstLocalAddr(3,numLocalCopies), & + halo%blockGlobalID(numLocalBlocks), & stat = istat) if (istat > 0) then @@ -1067,10 +1079,13 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%tripoleRows = tripoleRows halo%tripoleTFlag = tripoleTFlag halo%numLocalCopies = numLocalCopies + halo%numLocalBlocks = numLocalBlocks halo%srcLocalAddr = basehalo%srcLocalAddr(:,1:numLocalCopies) halo%dstLocalAddr = basehalo%dstLocalAddr(:,1:numLocalCopies) + halo%blockGlobalID = basehalo%blockGlobalID + numMsgSend = 0 do nmsg=1,basehalo%numMsgSend scnt = 0 @@ -1176,7 +1191,8 @@ subroutine ice_HaloUpdate2DR8(array, halo, & !----------------------------------------------------------------------- integer (int_kind) :: & - i,j,n,nmsg, &! dummy loop indices + i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1285,13 +1301,18 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1569,6 +1590,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -1677,13 +1699,18 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1961,6 +1988,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & integer (int_kind) :: & i,j,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message @@ -2069,13 +2097,18 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2353,6 +2386,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -2489,13 +2523,18 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2804,6 +2843,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -2940,13 +2980,18 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3255,6 +3300,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & integer (int_kind) :: & i,j,k,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension @@ -3391,13 +3437,18 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3706,6 +3757,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -3846,13 +3898,18 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -4181,6 +4238,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4321,13 +4379,18 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -4656,6 +4719,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & integer (int_kind) :: & i,j,k,l,n,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill ierr, &! error or status flag for MPI,alloc nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions @@ -4796,13 +4860,18 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -5232,13 +5301,18 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & ! the tripole zipper as needed for stresses. if you zero ! it out, all halo values will be wiped out. !----------------------------------------------------------------------- -! do j = 1,nghost -! array1(1:nx_block, j,:) = fill -! array1(1:nx_block,ny_block-j+1,:) = fill -! enddo -! do i = 1,nghost -! array1(i, 1:ny_block,:) = fill -! array1(nx_block-i+1,1:ny_block,:) = fill +! do iblk = 1, halo%numLocalBlocks +! call get_block_parameter(halo%blockGlobalID(iblk), & +! ilo=ilo, ihi=ihi, & +! jlo=jlo, jhi=jhi) +! do j = 1,nghost +! array(1:nx_block, jlo-j,iblk) = fill +! array(1:nx_block, jhi+j,iblk) = fill +! enddo +! do i = 1,nghost +! array(ilo-i, 1:ny_block,iblk) = fill +! array(ihi+i, 1:ny_block,iblk) = fill +! enddo ! enddo !----------------------------------------------------------------------- @@ -6715,20 +6789,20 @@ subroutine ice_HaloDestroy(halo) character(len=*), parameter :: subname = '(ice_HaloDestroy)' !----------------------------------------------------------------------- - deallocate(halo%sendTask, stat=istat) - deallocate(halo%recvTask, stat=istat) - deallocate(halo%sizeSend, stat=istat) - deallocate(halo%sizeRecv, stat=istat) - deallocate(halo%tripSend, stat=istat) - deallocate(halo%tripRecv, stat=istat) - deallocate(halo%srcLocalAddr, stat=istat) - deallocate(halo%dstLocalAddr, stat=istat) - deallocate(halo%sendAddr, stat=istat) - deallocate(halo%recvAddr, stat=istat) + deallocate(halo%sendTask, & + halo%recvTask, & + halo%sizeSend, & + halo%sizeRecv, & + halo%tripSend, & + halo%tripRecv, & + halo%srcLocalAddr, & + halo%dstLocalAddr, & + halo%sendAddr, & + halo%recvAddr, & + halo%blockGlobalID, stat=istat) if (istat > 0) then - call abort_ice( & - 'ice_HaloDestroy: error deallocating') + call abort_ice(subname,' ERROR: deallocating') return endif end subroutine ice_HaloDestroy diff --git a/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 b/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 index 6f9c8b0c6..046cf9336 100644 --- a/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 +++ b/cicecore/cicedynB/infrastructure/comm/mpi/ice_timers.F90 @@ -60,6 +60,7 @@ module ice_timers #endif timer_bound, &! boundary updates timer_bgc, &! biogeochemistry + timer_forcing, &! forcing timer_evp_1d, &! timer only loop timer_evp_2d ! timer including conversion 1d/2d ! timer_tmp ! for temporary timings @@ -179,6 +180,7 @@ subroutine init_ice_timers call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) #if (defined CESMCOUPLED) call get_ice_timer(timer_cplrecv, 'Cpl-recv', nblocks,distrb_info%nprocs) call get_ice_timer(timer_rcvsnd, 'Rcv->Snd', nblocks,distrb_info%nprocs) diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 index 9c2cfd9fc..c66cdd13c 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_boundary.F90 @@ -40,12 +40,16 @@ module ice_boundary type, public :: ice_halo integer (int_kind) :: & communicator, &! communicator to use for update messages + numLocalBlocks, &! number of local blocks, needed for halo fill numLocalCopies, &! num local copies for halo update tripoleRows ! number of rows in tripole buffer logical (log_kind) :: & tripoleTFlag ! NS boundary is a tripole T-fold + integer (int_kind), dimension(:), pointer :: & + blockGlobalID ! list of local block global IDs, needed for halo fill + integer (int_kind), dimension(:,:), pointer :: & srcLocalAddr, &! src addresses for each local copy dstLocalAddr ! dst addresses for each local copy @@ -174,6 +178,13 @@ function ice_HaloCreate(dist, nsBoundaryType, ewBoundaryType, & cornerMsgSize = nghost*nghost tripoleRows = nghost+1 + !*** store some block info to fill haloes properly + call ice_distributionGet(dist, numLocalBlocks=halo%numLocalBlocks) + if (halo%numLocalBlocks > 0) then + allocate(halo%blockGlobalID(halo%numLocalBlocks)) + call ice_distributionGet(dist, blockGlobalID=halo%blockGlobalID) + endif + if (nsBoundaryType == 'tripole' .or. nsBoundaryType == 'tripoleT') then tripoleTFlag = (nsBoundaryType == 'tripoleT') if (tripoleTflag) tripoleRows = tripoleRows+1 @@ -581,6 +592,7 @@ subroutine ice_HaloMask(halo, basehalo, mask) istat, &! allocate status flag communicator, &! communicator for message passing numLocalCopies, &! num local copies for halo update + numLocalBlocks, &! num local blocks for halo fill tripoleRows ! number of rows in tripole buffer logical (log_kind) :: & @@ -599,9 +611,11 @@ subroutine ice_HaloMask(halo, basehalo, mask) tripoleRows = basehalo%tripoleRows tripoleTFlag = basehalo%tripoleTFlag numLocalCopies = basehalo%numLocalCopies + numLocalBlocks = basehalo%numLocalBlocks allocate(halo%srcLocalAddr(3,numLocalCopies), & halo%dstLocalAddr(3,numLocalCopies), & + halo%blockGlobalID(numLocalBlocks), & stat = istat) if (istat > 0) then @@ -613,10 +627,13 @@ subroutine ice_HaloMask(halo, basehalo, mask) halo%tripoleRows = tripoleRows halo%tripoleTFlag = tripoleTFlag halo%numLocalCopies = numLocalCopies + halo%numLocalBlocks = numLocalBlocks halo%srcLocalAddr = basehalo%srcLocalAddr halo%dstLocalAddr = basehalo%dstLocalAddr + halo%blockGlobalID = basehalo%blockGlobalID + !----------------------------------------------------------------------- end subroutine ice_HaloMask @@ -659,6 +676,7 @@ subroutine ice_HaloUpdate2DR8(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -699,13 +717,18 @@ subroutine ice_HaloUpdate2DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -945,6 +968,7 @@ subroutine ice_HaloUpdate2DR4(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -985,13 +1009,18 @@ subroutine ice_HaloUpdate2DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1231,6 +1260,7 @@ subroutine ice_HaloUpdate2DI4(array, halo, & integer (int_kind) :: & i,j,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) iSrc,jSrc, &! source addresses for message iDst,jDst, &! dest addresses for message @@ -1271,13 +1301,18 @@ subroutine ice_HaloUpdate2DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:) = fill - array(1:nx_block,ny_block-j+1,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:) = fill - array(nx_block-i+1,1:ny_block,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,iblk) = fill + array(1:nx_block, jhi+j,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,iblk) = fill + array(ihi+i, 1:ny_block,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1517,6 +1552,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -1564,13 +1600,18 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -1829,6 +1870,7 @@ subroutine ice_HaloUpdate3DR4(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -1876,13 +1918,18 @@ subroutine ice_HaloUpdate3DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2141,6 +2188,7 @@ subroutine ice_HaloUpdate3DI4(array, halo, & integer (int_kind) :: & i,j,k,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, &! size of array in 3rd dimension iSrc,jSrc, &! source addresses for message @@ -2188,13 +2236,18 @@ subroutine ice_HaloUpdate3DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,iblk) = fill + array(1:nx_block, jhi+j,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,iblk) = fill + array(ihi+i, 1:ny_block,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2453,6 +2506,7 @@ subroutine ice_HaloUpdate4DR8(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -2501,13 +2555,18 @@ subroutine ice_HaloUpdate4DR8(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -2782,6 +2841,7 @@ subroutine ice_HaloUpdate4DR4(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -2830,13 +2890,18 @@ subroutine ice_HaloUpdate4DR4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3111,6 +3176,7 @@ subroutine ice_HaloUpdate4DI4(array, halo, & integer (int_kind) :: & i,j,k,l,nmsg, &! dummy loop indices + iblk,ilo,ihi,jlo,jhi, &! block sizes for fill nxGlobal, &! global domain size in x (tripole) nz, nt, &! size of array in 3rd,4th dimensions iSrc,jSrc, &! source addresses for message @@ -3159,13 +3225,18 @@ subroutine ice_HaloUpdate4DI4(array, halo, & ! !----------------------------------------------------------------------- - do j = 1,nghost - array(1:nx_block, j,:,:,:) = fill - array(1:nx_block,ny_block-j+1,:,:,:) = fill - enddo - do i = 1,nghost - array(i, 1:ny_block,:,:,:) = fill - array(nx_block-i+1,1:ny_block,:,:,:) = fill + do iblk = 1, halo%numLocalBlocks + call get_block_parameter(halo%blockGlobalID(iblk), & + ilo=ilo, ihi=ihi, & + jlo=jlo, jhi=jhi) + do j = 1,nghost + array(1:nx_block, jlo-j,:,:,iblk) = fill + array(1:nx_block, jhi+j,:,:,iblk) = fill + enddo + do i = 1,nghost + array(ilo-i, 1:ny_block,:,:,iblk) = fill + array(ihi+i, 1:ny_block,:,:,iblk) = fill + enddo enddo !----------------------------------------------------------------------- @@ -3472,13 +3543,18 @@ subroutine ice_HaloUpdate_stress(array1, array2, halo, & ! the tripole zipper as needed for stresses. if you zero ! it out, all halo values will be wiped out. !----------------------------------------------------------------------- -! do j = 1,nghost -! array1(1:nx_block, j,:) = fill -! array1(1:nx_block,ny_block-j+1,:) = fill -! enddo -! do i = 1,nghost -! array1(i, 1:ny_block,:) = fill -! array1(nx_block-i+1,1:ny_block,:) = fill +! do iblk = 1, halo%numLocalBlocks +! call get_block_parameter(halo%blockGlobalID(iblk), & +! ilo=ilo, ihi=ihi, & +! jlo=jlo, jhi=jhi) +! do j = 1,nghost +! array(1:nx_block, jlo-j,iblk) = fill +! array(1:nx_block, jhi+j,iblk) = fill +! enddo +! do i = 1,nghost +! array(ilo-i, 1:ny_block,iblk) = fill +! array(ihi+i, 1:ny_block,iblk) = fill +! enddo ! enddo !----------------------------------------------------------------------- @@ -4500,8 +4576,14 @@ subroutine ice_HaloDestroy(halo) !----------------------------------------------------------------------- - deallocate(halo%srcLocalAddr, stat=istat) - deallocate(halo%dstLocalAddr, stat=istat) + deallocate(halo%srcLocalAddr, & + halo%dstLocalAddr, & + halo%blockGlobalID, stat=istat) + + if (istat > 0) then + call abort_ice(subname,' ERROR: deallocating') + return + endif end subroutine ice_HaloDestroy diff --git a/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 b/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 index 3074c1dc9..4599de42e 100644 --- a/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 +++ b/cicecore/cicedynB/infrastructure/comm/serial/ice_timers.F90 @@ -52,6 +52,7 @@ module ice_timers timer_hist, &! diagnostics/history timer_bound, &! boundary updates timer_bgc, &! biogeochemistry + timer_forcing, &! forcing timer_evp_1d, &! timer only loop timer_evp_2d ! timer including conversion 1d/2d ! timer_tmp ! for temporary timings @@ -193,8 +194,9 @@ subroutine init_ice_timers call get_ice_timer(timer_hist, 'History ',nblocks,distrb_info%nprocs) call get_ice_timer(timer_bound, 'Bound', nblocks,distrb_info%nprocs) call get_ice_timer(timer_bgc, 'BGC', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) - call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_forcing, 'Forcing', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp_1d, '1d-evp', nblocks,distrb_info%nprocs) + call get_ice_timer(timer_evp_2d, '2d-evp', nblocks,distrb_info%nprocs) ! call get_ice_timer(timer_tmp, ' ',nblocks,distrb_info%nprocs) !----------------------------------------------------------------------- diff --git a/cicecore/cicedynB/infrastructure/ice_blocks.F90 b/cicecore/cicedynB/infrastructure/ice_blocks.F90 index 5177dd047..2768a40c3 100644 --- a/cicecore/cicedynB/infrastructure/ice_blocks.F90 +++ b/cicecore/cicedynB/infrastructure/ice_blocks.F90 @@ -83,6 +83,9 @@ module ice_blocks nblocks_x ,&! tot num blocks in i direction nblocks_y ! tot num blocks in j direction + logical (kind=log_kind), public :: & + debug_blocks ! print verbose block information + !----------------------------------------------------------------------- ! ! module private data @@ -133,8 +136,6 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & iblock, jblock ,&! block loop indices is, ie, js, je ! temp start, end indices - logical (log_kind) :: dbug - character(len=*), parameter :: subname = '(create_blocks)' !---------------------------------------------------------------------- @@ -252,8 +253,8 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & !*** set last physical point if padded domain else if (j_global(j,n) == ny_global .and. & - j > all_blocks(n)%jlo .and. & - j < all_blocks(n)%jhi) then + j >= all_blocks(n)%jlo .and. & + j < all_blocks(n)%jhi) then all_blocks(n)%jhi = j ! last physical point in padded domain endif end do @@ -300,8 +301,8 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & !*** last physical point in padded domain else if (i_global(i,n) == nx_global .and. & - i > all_blocks(n)%ilo .and. & - i < all_blocks(n)%ihi) then + i >= all_blocks(n)%ilo .and. & + i < all_blocks(n)%ihi) then all_blocks(n)%ihi = i endif end do @@ -311,9 +312,7 @@ subroutine create_blocks(nx_global, ny_global, ew_boundary_type, & end do end do -! dbug = .true. - dbug = .false. - if (dbug) then + if (debug_blocks) then if (my_task == master_task) then write(nu_diag,*) 'block i,j locations' do n = 1, nblocks_tot diff --git a/cicecore/cicedynB/infrastructure/ice_domain.F90 b/cicecore/cicedynB/infrastructure/ice_domain.F90 index cc57ea585..52f0da850 100644 --- a/cicecore/cicedynB/infrastructure/ice_domain.F90 +++ b/cicecore/cicedynB/infrastructure/ice_domain.F90 @@ -21,7 +21,7 @@ module ice_domain add_mpi_barriers use ice_broadcast, only: broadcast_scalar, broadcast_array use ice_blocks, only: block, get_block, create_blocks, nghost, & - nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block + nblocks_x, nblocks_y, nblocks_tot, nx_block, ny_block, debug_blocks use ice_distribution, only: distrb use ice_boundary, only: ice_halo use ice_exit, only: abort_ice @@ -134,7 +134,8 @@ subroutine init_domain_blocks maskhalo_dyn, & maskhalo_remap, & maskhalo_bound, & - add_mpi_barriers + add_mpi_barriers, & + debug_blocks !---------------------------------------------------------------------- ! @@ -153,6 +154,7 @@ subroutine init_domain_blocks maskhalo_remap = .false. ! if true, use masked halos for transport maskhalo_bound = .false. ! if true, use masked halos for bound_state add_mpi_barriers = .false. ! if true, throttle communication + debug_blocks = .false. ! if true, print verbose block information max_blocks = -1 ! max number of blocks per processor block_size_x = -1 ! size of block in first horiz dimension block_size_y = -1 ! size of block in second horiz dimension @@ -190,12 +192,11 @@ subroutine init_domain_blocks call broadcast_scalar(maskhalo_remap, master_task) call broadcast_scalar(maskhalo_bound, master_task) call broadcast_scalar(add_mpi_barriers, master_task) + call broadcast_scalar(debug_blocks, master_task) if (my_task == master_task) then if (max_blocks < 1) then - max_blocks=int( & - ( (dble(nx_global-1)/dble(block_size_x + 1)) * & - (dble(ny_global-1)/dble(block_size_y + 1)) ) & - / dble(nprocs)) + max_blocks=( ((nx_global-1)/block_size_x + 1) * & + ((ny_global-1)/block_size_y + 1) - 1) / nprocs + 1 max_blocks=max(1,max_blocks) write(nu_diag,'(/,a52,i6,/)') & '(ice_domain): max_block < 1: max_block estimated to ',max_blocks @@ -268,6 +269,7 @@ subroutine init_domain_blocks write(nu_diag,'(a,l6)') ' maskhalo_remap = ', maskhalo_remap write(nu_diag,'(a,l6)') ' maskhalo_bound = ', maskhalo_bound write(nu_diag,'(a,l6)') ' add_mpi_barriers = ', add_mpi_barriers + write(nu_diag,'(a,l6)') ' debug_blocks = ', debug_blocks write(nu_diag,'(a,2i6)') ' block_size_x,_y = ', block_size_x, block_size_y write(nu_diag,'(a,i6)') ' max_blocks = ', max_blocks write(nu_diag,'(a,i6,/)')' Number of ghost cells = ', nghost @@ -287,7 +289,7 @@ subroutine init_domain_distribution(KMTG,ULATG) ! initialized here through calls to the appropriate boundary routines. use ice_boundary, only: ice_HaloCreate - use ice_distribution, only: create_distribution, create_local_block_ids + use ice_distribution, only: create_distribution, create_local_block_ids, ice_distributionGet use ice_domain_size, only: max_blocks, nx_global, ny_global real (dbl_kind), dimension(nx_global,ny_global), intent(in) :: & @@ -311,6 +313,7 @@ subroutine init_domain_distribution(KMTG,ULATG) integer (int_kind) :: & i,j,n ,&! dummy loop indices ig,jg ,&! global indices + ninfo ,&! ice_distributionGet check work_unit ,&! size of quantized work unit #ifdef USE_NETCDF fid ,&! file id @@ -326,6 +329,7 @@ subroutine init_domain_distribution(KMTG,ULATG) rad_to_deg ! radians to degrees integer (int_kind), dimension(:), allocatable :: & + blkinfo ,&! ice_distributionGet check nocn ,&! number of ocean points per block work_per_block ! number of work units per block @@ -449,7 +453,6 @@ subroutine init_domain_distribution(KMTG,ULATG) if (my_task == master_task) then ! cannot use ice_read_write due to circular dependency #ifdef USE_NETCDF - write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) status = nf90_open(distribution_wght_file, NF90_NOWRITE, fid) if (status /= nf90_noerr) then call abort_ice (subname//'ERROR: Cannot open '//trim(distribution_wght_file)) @@ -457,6 +460,7 @@ subroutine init_domain_distribution(KMTG,ULATG) status = nf90_inq_varid(fid, 'wght', varid) status = nf90_get_var(fid, varid, wght) status = nf90_close(fid) + write(nu_diag,*) 'read ',trim(distribution_wght_file),minval(wght),maxval(wght) #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & file=__FILE__, line=__LINE__) @@ -563,6 +567,49 @@ subroutine init_domain_distribution(KMTG,ULATG) call create_local_block_ids(blocks_ice, distrb_info) + ! internal check of icedistributionGet as part of verification process + if (debug_blocks) then + call ice_distributionGet(distrb_info, nprocs=ninfo) + if (ninfo /= distrb_info%nprocs) & + call abort_ice(subname//' ice_distributionGet nprocs ERROR', file=__FILE__, line=__LINE__) + + call ice_distributionGet(distrb_info, communicator=ninfo) + if (ninfo /= distrb_info%communicator) & + call abort_ice(subname//' ice_distributionGet communicator ERROR', file=__FILE__, line=__LINE__) + + call ice_distributionGet(distrb_info, numLocalBlocks=ninfo) + if (ninfo /= distrb_info%numLocalBlocks) & + call abort_ice(subname//' ice_distributionGet numLocalBlocks ERROR', file=__FILE__, line=__LINE__) + + allocate(blkinfo(ninfo)) + + call ice_distributionGet(distrb_info, blockGlobalID = blkinfo) + do n = 1, ninfo + if (blkinfo(n) /= distrb_info%blockGlobalID(n)) & + call abort_ice(subname//' ice_distributionGet blockGlobalID ERROR', file=__FILE__, line=__LINE__) + enddo + + deallocate(blkinfo) + allocate(blkinfo(nblocks_tot)) + + call ice_distributionGet(distrb_info, blockLocation = blkinfo) + do n = 1, nblocks_tot + if (blkinfo(n) /= distrb_info%blockLocation(n)) & + call abort_ice(subname//' ice_distributionGet blockLocation ERROR', file=__FILE__, line=__LINE__) + enddo + + call ice_distributionGet(distrb_info, blockLocalID = blkinfo) + do n = 1, nblocks_tot + if (blkinfo(n) /= distrb_info%blockLocalID(n)) & + call abort_ice(subname//' ice_distributionGet blockLocalID ERROR', file=__FILE__, line=__LINE__) + enddo + + deallocate(blkinfo) + + if (my_task == master_task) & + write(nu_diag,*) subname,' ice_distributionGet checks pass' + endif + if (associated(blocks_ice)) then nblocks = size(blocks_ice) else diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index a354efb6b..2304877d2 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -26,7 +26,7 @@ module ice_grid use ice_domain, only: blocks_ice, nblocks, halo_info, distrb_info, & ew_boundary_type, ns_boundary_type, init_domain_distribution use ice_fileunits, only: nu_diag, nu_grid, nu_kmt, & - get_fileunit, release_fileunit + get_fileunit, release_fileunit, flush_fileunit use ice_gather_scatter, only: gather_global, scatter_global use ice_read_write, only: ice_read, ice_read_nc, ice_read_global, & ice_read_global_nc, ice_open, ice_open_nc, ice_close_nc @@ -384,11 +384,9 @@ subroutine init_grid2 ! T-grid cell and U-grid cell quantities !----------------------------------------------------------------- -! tarea(:,:,:) = c0 - !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -486,7 +484,7 @@ subroutine init_grid2 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP angle_0,angle_w,angle_s,angle_sw) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -642,7 +640,7 @@ subroutine popgrid kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -785,7 +783,7 @@ subroutine popgrid_nc kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1104,7 +1102,7 @@ subroutine latlongrid !$OMP PARALLEL DO PRIVATE(iblk,this_block,ilo,ihi,jlo,jhi,i,j) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1198,15 +1196,9 @@ subroutine rectgrid if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - !$OMP PARALLEL DO PRIVATE(iblk,i,j) - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - ANGLE(i,j,iblk) = c0 ! "square with the world" - enddo - enddo - enddo - !$OMP END PARALLEL DO + hm (:,:,:) = c0 + kmt(:,:,:) = c0 + angle(:,:,:) = c0 ! "square with the world" allocate(work_g1(nx_global,ny_global)) @@ -1396,7 +1388,7 @@ subroutine cpomgrid kmt(:,:,:) = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1636,11 +1628,10 @@ subroutine makemask !----------------------------------------------------------------- bm = c0 -! uvm = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1663,12 +1654,19 @@ subroutine makemask field_loc_center, field_type_scalar) call ice_timer_stop(timer_bound) - !$OMP PARALLEL DO PRIVATE(iblk,i,j) + !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - tmask(i,j,iblk) = .false. - umask(i,j,iblk) = .false. + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + ! needs to cover halo (no halo update for logicals) + tmask(:,:,iblk) = .false. + umask(:,:,iblk) = .false. + do j = jlo-nghost, jhi+nghost + do i = ilo-nghost, ihi+nghost if ( hm(i,j,iblk) > p5) tmask(i,j,iblk) = .true. if (uvm(i,j,iblk) > p5) umask(i,j,iblk) = .true. enddo @@ -1684,11 +1682,14 @@ subroutine makemask tarean(:,:,iblk) = c0 tareas(:,:,iblk) = c0 - do j = 1, ny_block - do i = 1, nx_block + do j = jlo,jhi + do i = ilo,ihi - if (ULAT(i,j,iblk) >= -puny) lmask_n(i,j,iblk) = .true. ! N. Hem. - if (ULAT(i,j,iblk) < -puny) lmask_s(i,j,iblk) = .true. ! S. Hem. + if (ULAT(i,j,iblk) >= -puny) then + lmask_n(i,j,iblk) = .true. ! N. Hem. + else + lmask_s(i,j,iblk) = .true. ! S. Hem. + endif ! N hemisphere area mask (m^2) if (lmask_n(i,j,iblk)) tarean(i,j,iblk) = tarea(i,j,iblk) & @@ -1743,7 +1744,7 @@ subroutine Tlatlon !$OMP x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4, & !$OMP tx,ty,tz,da) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -1915,7 +1916,7 @@ subroutine to_ugrid(work1,work2) !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2000,7 +2001,7 @@ subroutine to_tgrid(work1, work2) !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2073,7 +2074,7 @@ subroutine gridbox_corners !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks - this_block = get_block(blocks_ice(iblk),iblk) + this_block = get_block(blocks_ice(iblk),iblk) ilo = this_block%ilo ihi = this_block%ihi jlo = this_block%jlo @@ -2400,8 +2401,9 @@ subroutine get_bathymetry do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - k = kmt(i,j,iblk) - if (k > puny) bathymetry(i,j,iblk) = depth(k) + k = min(nint(kmt(i,j,iblk)),nlevel) + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') + if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo enddo @@ -2431,7 +2433,7 @@ subroutine get_bathymetry_popfile character(len=*), parameter :: subname = '(get_bathymetry_popfile)' - ntmp = maxval(KMT) + ntmp = maxval(nint(KMT)) nlevel = global_maxval(ntmp,distrb_info) if (my_task==master_task) then @@ -2491,8 +2493,8 @@ subroutine get_bathymetry_popfile do iblk = 1, nblocks do j = 1, ny_block do i = 1, nx_block - k = kmt(i,j,iblk) - if (k > nlevel) call abort_ice(subname//' kmt/nlevel error') + k = nint(kmt(i,j,iblk)) + if (k > nlevel) call abort_ice(subname//' kmt gt nlevel error') if (k > 0) bathymetry(i,j,iblk) = depth(k) enddo enddo diff --git a/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index 87d0813cc..d902c62f8 100644 --- a/cicecore/cicedynB/infrastructure/ice_read_write.F90 +++ b/cicecore/cicedynB/infrastructure/ice_read_write.F90 @@ -1116,6 +1116,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! dimlen ! dimension size real (kind=dbl_kind) :: & + missingvalue, & amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & @@ -1141,6 +1142,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & nx = nx_global ny = ny_global + work = c0 ! to satisfy intent(out) attribute + if (present(restart_ext)) then if (restart_ext) then nx = nx_global + 2*nghost @@ -1181,6 +1184,7 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & count=(/nx,ny,1/) ) endif + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task !------------------------------------------------------------------- @@ -1188,9 +1192,9 @@ 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, & -! ', varname = ',trim(varname) + write(nu_diag,*) & + 'ice_read_nc_xy, fid= ',fid, ', nrec = ',nrec, & + ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim @@ -1198,8 +1202,8 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & ! write(nu_diag,*) '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) + 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) endif @@ -1223,12 +1227,15 @@ subroutine ice_read_nc_xy(fid, nrec, varname, work, diag, & endif deallocate(work_g1) + +! echmod: this should not be necessary if fill/missing are only on land + where (work > 1.0e+30_dbl_kind) work = c0 + 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__) - work = c0 ! to satisfy intent(out) attribute #endif end subroutine ice_read_nc_xy @@ -1282,6 +1289,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! dimlen ! size of dimension real (kind=dbl_kind) :: & + missingvalue, & ! missing value amin, amax, asum ! min, max values and sum of input array ! character (char_len) :: & @@ -1347,6 +1355,7 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & count=(/nx,ny,ncat,1/) ) endif + status = nf90_get_att(fid, varid, "_FillValue", missingvalue) endif ! my_task = master_task !------------------------------------------------------------------- @@ -1354,9 +1363,9 @@ 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, & -! ', varname = ',trim(varname) + write(nu_diag,*) & + 'ice_read_nc_xyz, fid= ',fid, ', nrec = ',nrec, & + ', varname = ',trim(varname) ! status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar) ! write(nu_diag,*) 'ndim= ',ndim,', nvar= ',nvar ! do id=1,ndim @@ -1365,8 +1374,8 @@ subroutine ice_read_nc_xyz(fid, nrec, varname, work, diag, & ! enddo do n=1,ncat 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) + 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) enddo endif diff --git a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 index 5a6c79503..1a5681b38 100644 --- a/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restart_driver.F90 @@ -197,7 +197,7 @@ subroutine restartfile (ice_ic) use ice_boundary, only: ice_HaloUpdate_stress use ice_blocks, only: nghost, nx_block, ny_block - use ice_calendar, only: istep0, npt + use ice_calendar, only: istep0, npt, calendar use ice_communicate, only: my_task, master_task use ice_domain, only: nblocks, halo_info use ice_domain_size, only: nilyr, nslyr, ncat, & @@ -244,6 +244,7 @@ subroutine restartfile (ice_ic) file=__FILE__, line=__LINE__) call init_restart_read(ice_ic) + call calendar() diag = .true. @@ -529,7 +530,8 @@ subroutine restartfile_v4 (ice_ic) use ice_broadcast, only: broadcast_scalar use ice_blocks, only: nghost, nx_block, ny_block - use ice_calendar, only: istep0, istep1, time, time_forc, calendar, npt + use ice_calendar, only: istep0, istep1, timesecs, calendar, npt, & + set_date_from_timesecs use ice_communicate, only: my_task, master_task use ice_domain, only: nblocks, distrb_info use ice_domain_size, only: nilyr, nslyr, ncat, nx_global, ny_global, & @@ -571,6 +573,9 @@ subroutine restartfile_v4 (ice_ic) real (kind=dbl_kind), dimension(:,:), allocatable :: & work_g1, work_g2 + real (kind=dbl_kind) :: & + time_forc ! historic, now local + character(len=*), parameter :: subname = '(restartfile_v4)' call icepack_query_tracer_sizes(ntrcr_out=ntrcr) @@ -602,14 +607,15 @@ subroutine restartfile_v4 (ice_ic) if (use_restart_time) then if (my_task == master_task) then - read (nu_restart) istep0,time,time_forc - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + read (nu_restart) istep0,timesecs,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,timesecs endif call broadcast_scalar(istep0,master_task) istep1 = istep0 - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call calendar(time) + call broadcast_scalar(timesecs,master_task) +! call broadcast_scalar(time_forc,master_task) + call set_date_from_timesecs(timesecs) + call calendar() else diff --git a/cicecore/cicedynB/infrastructure/ice_restoring.F90 b/cicecore/cicedynB/infrastructure/ice_restoring.F90 index 38104315d..c7254cd80 100644 --- a/cicecore/cicedynB/infrastructure/ice_restoring.F90 +++ b/cicecore/cicedynB/infrastructure/ice_restoring.F90 @@ -98,6 +98,11 @@ subroutine ice_HaloRestore_init vsnon_rest(nx_block,ny_block,ncat,max_blocks), & trcrn_rest(nx_block,ny_block,ntrcr,ncat,max_blocks)) + aicen_rest(:,:,:,:) = c0 + vicen_rest(:,:,:,:) = c0 + vsnon_rest(:,:,:,:) = c0 + trcrn_rest(:,:,:,:,:) = c0 + !----------------------------------------------------------------------- ! initialize ! halo cells have to be filled manually at this stage diff --git a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 index b1a2d026b..91d57ea48 100644 --- a/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_binary/ice_restart.F90 @@ -31,6 +31,8 @@ module ice_restart public :: init_restart_write, init_restart_read, & read_restart_field, write_restart_field, final_restart + real(kind=dbl_kind) :: time_forc = -99. ! historic now local + !======================================================================= contains @@ -42,7 +44,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: istep0, istep1, time, time_forc, npt, nyr + use ice_calendar, only: istep0, istep1, timesecs, npt, myear, & + set_date_from_timesecs use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -105,17 +108,18 @@ subroutine init_restart_read(ice_ic) call ice_open(nu_restart,trim(filename),0) endif if (use_restart_time) then - read (nu_restart) istep0,time,time_forc,nyr + read (nu_restart) istep0,timesecs,time_forc,myear else read (nu_restart) iignore,rignore,rignore ! use namelist values endif - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,timesecs endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) + call broadcast_scalar(timesecs,master_task) call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) + call broadcast_scalar(myear,master_task) + call set_date_from_timesecs(timesecs) istep1 = istep0 @@ -375,8 +379,8 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1, & + timesecs use ice_communicate, only: my_task, master_task use ice_dyn_shared, only: kdyn use ice_read_write, only: ice_open, ice_open_ext @@ -391,8 +395,7 @@ subroutine init_restart_write(filename_spec) tr_pond_topo, tr_pond_lvl, tr_brine integer (kind=int_kind) :: & - nbtrcr, & ! number of bgc tracers - iyear, imonth, iday ! year, month, day + nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename @@ -414,14 +417,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - imonth = month - iday = mday - 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)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if ! write pointer (path/file) @@ -434,7 +433,7 @@ subroutine init_restart_write(filename_spec) else call ice_open(nu_dump,filename,0) endif - write(nu_dump) istep1,time,time_forc,nyr + write(nu_dump) istep1,timesecs,time_forc,myear write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -445,7 +444,7 @@ subroutine init_restart_write(filename_spec) 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)),'.eap.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_eap,filename,0) @@ -454,7 +453,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_eap) istep1,time,time_forc + write(nu_dump_eap) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -465,7 +464,7 @@ subroutine init_restart_write(filename_spec) 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)),'.fsd.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_fsd,filename,0) @@ -474,7 +473,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_fsd) istep1,time,time_forc + write(nu_dump_fsd) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -485,7 +484,7 @@ subroutine init_restart_write(filename_spec) 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)),'.FY.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_FY,filename,0) @@ -494,7 +493,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_FY) istep1,time,time_forc + write(nu_dump_FY) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -505,7 +504,7 @@ subroutine init_restart_write(filename_spec) 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)),'.iage.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_age,filename,0) @@ -514,7 +513,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_age) istep1,time,time_forc + write(nu_dump_age) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -525,7 +524,7 @@ subroutine init_restart_write(filename_spec) 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)),'.lvl.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_lvl,filename,0) @@ -534,7 +533,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_lvl) istep1,time,time_forc + write(nu_dump_lvl) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -545,7 +544,7 @@ subroutine init_restart_write(filename_spec) 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)),'.pond_cesm.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -554,7 +553,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -565,7 +564,7 @@ subroutine init_restart_write(filename_spec) 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)),'.pond_lvl.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -574,7 +573,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -585,7 +584,7 @@ subroutine init_restart_write(filename_spec) 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)),'.pond_topo.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_pond,filename,0) @@ -594,7 +593,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_pond) istep1,time,time_forc + write(nu_dump_pond) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -605,7 +604,7 @@ subroutine init_restart_write(filename_spec) 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)),'.brine.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_hbrine,filename,0) @@ -614,7 +613,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_hbrine) istep1,time,time_forc + write(nu_dump_hbrine) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -625,7 +624,7 @@ subroutine init_restart_write(filename_spec) 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)),'.bgc.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_bgc,filename,0) @@ -634,7 +633,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_bgc) istep1,time,time_forc + write(nu_dump_bgc) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif endif @@ -644,7 +643,7 @@ subroutine init_restart_write(filename_spec) 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)),'.iso.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_iso,filename,0) @@ -653,7 +652,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_iso) istep1,time,time_forc + write(nu_dump_iso) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -664,7 +663,7 @@ subroutine init_restart_write(filename_spec) 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)),'.aero.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec if (restart_ext) then call ice_open_ext(nu_dump_aero,filename,0) @@ -673,7 +672,7 @@ subroutine init_restart_write(filename_spec) endif if (my_task == master_task) then - write(nu_dump_aero) istep1,time,time_forc + write(nu_dump_aero) istep1,timesecs,time_forc write(nu_diag,*) 'Writing ',filename(1:lenstr(filename)) endif @@ -803,7 +802,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, timesecs use ice_communicate, only: my_task, master_task logical (kind=log_kind) :: & @@ -843,7 +842,7 @@ subroutine final_restart() if (solve_zsal .or. nbtrcr > 0) & close(nu_dump_bgc) - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,timesecs endif end subroutine final_restart 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 b3024302e..9c6b30ee1 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 @@ -47,8 +47,9 @@ subroutine ice_write_hist (ns) use ice_arrays_column, only: hin_max, floe_rad_c use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: time, sec, idate, idate0, write_ic, & - histfreq, dayyr, days_per_year, use_leap_years + use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & + histfreq, days_per_year, use_leap_years, dayyr, & + year_init, month_init, day_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 @@ -80,7 +81,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) @@ -133,8 +133,7 @@ subroutine ice_write_hist (ns) if (my_task == master_task) then -! ltime=time/int(secday) - ltime2=time/int(secday) + ltime2 = timesecs/secday call construct_filename(ncfile(ns),'nc',ns) @@ -1038,9 +1037,9 @@ subroutine ice_write_hist (ns) 'ERROR: global attribute source') if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',int(dayyr),' days' + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' else - write(title,'(a,i3,a)') 'All years have exactly ',int(dayyr),' days' + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif status = nf90_put_att(ncid,nf90_global,'comment',title) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1051,7 +1050,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: global attribute date1') - write(title,'(a,i6)') 'seconds elapsed into model date: ',sec + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec status = nf90_put_att(ncid,nf90_global,'comment3',title) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: global attribute date2') @@ -1091,7 +1090,6 @@ subroutine ice_write_hist (ns) status = nf90_inq_varid(ncid,'time',varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting time varid') -!sgl status = nf90_put_var(ncid,varid,ltime) status = nf90_put_var(ncid,varid,ltime2) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing time variable') diff --git a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 index 53c7dac60..e744caf09 100644 --- a/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_restart.F90 @@ -42,8 +42,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: sec, month, mday, nyr, istep0, istep1, & - time, time_forc, npt + use ice_calendar, only: msec, mmonth, mday, myear, & + istep0, istep1, npt use ice_communicate, only: my_task, master_task character(len=char_len_long), intent(in), optional :: ice_ic @@ -53,7 +53,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status + integer (kind=int_kind) :: status, status1 character(len=*), parameter :: subname = '(init_restart_read)' @@ -79,24 +79,36 @@ subroutine init_restart_read(ice_ic) 'ERROR: reading restart ncfile '//trim(filename)) if (use_restart_time) then - status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) - status = nf90_get_att(ncid, nf90_global, 'time', time) - status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) - status = nf90_get_att(ncid, nf90_global, 'nyr', nyr) - if (status == nf90_noerr) then - status = nf90_get_att(ncid, nf90_global, 'month', month) + status1 = nf90_noerr + status = nf90_get_att(ncid, nf90_global, 'istep1', istep0) + if (status /= nf90_noerr) status1 = status +! status = nf90_get_att(ncid, nf90_global, 'time', time) +! status = nf90_get_att(ncid, nf90_global, 'time_forc', time_forc) + status = nf90_get_att(ncid, nf90_global, 'myear', myear) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'nyr', myear) + if (status /= nf90_noerr) status1 = status + status = nf90_get_att(ncid, nf90_global, 'mmonth', mmonth) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'month', mmonth) + if (status /= nf90_noerr) status1 = status status = nf90_get_att(ncid, nf90_global, 'mday', mday) - status = nf90_get_att(ncid, nf90_global, 'sec', sec) - endif + if (status /= nf90_noerr) status1 = status + status = nf90_get_att(ncid, nf90_global, 'msec', msec) + if (status /= nf90_noerr) status = nf90_get_att(ncid, nf90_global, 'sec', msec) + if (status /= nf90_noerr) status1 = status + if (status1 /= nf90_noerr) call abort_ice(subname// & + 'ERROR: reading restart time '//trim(filename)) endif ! use namelist values if use_restart_time = F endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) - +! call broadcast_scalar(time,master_task) + call broadcast_scalar(myear,master_task) + call broadcast_scalar(mmonth,master_task) + call broadcast_scalar(mday,master_task) + call broadcast_scalar(msec,master_task) +! call broadcast_scalar(time_forc,master_task) + istep1 = istep0 ! if runid is bering then need to correct npt for istep0 @@ -118,8 +130,7 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) use ice_blocks, only: nghost - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1 use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & @@ -145,7 +156,6 @@ subroutine init_restart_write(filename_spec) integer (kind=int_kind) :: & k, n, & ! index nx, ny, & ! global array size - iyear, & ! year nbtrcr ! number of bgc tracers character(len=char_len_long) :: filename @@ -186,12 +196,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - 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)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if ! write pointer (path/file) @@ -208,12 +216,12 @@ subroutine init_restart_write(filename_spec) 'ERROR: creating restart ncfile '//trim(filename)) status = nf90_put_att(ncid,nf90_global,'istep1',istep1) - status = nf90_put_att(ncid,nf90_global,'time',time) - status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) - status = nf90_put_att(ncid,nf90_global,'nyr',nyr) - status = nf90_put_att(ncid,nf90_global,'month',month) +! status = nf90_put_att(ncid,nf90_global,'time',time) +! status = nf90_put_att(ncid,nf90_global,'time_forc',time_forc) + status = nf90_put_att(ncid,nf90_global,'myear',myear) + status = nf90_put_att(ncid,nf90_global,'mmonth',mmonth) status = nf90_put_att(ncid,nf90_global,'mday',mday) - status = nf90_put_att(ncid,nf90_global,'sec',sec) + status = nf90_put_att(ncid,nf90_global,'msec',msec) nx = nx_global ny = ny_global @@ -795,7 +803,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, idate use ice_communicate, only: my_task, master_task integer (kind=int_kind) :: status @@ -806,7 +814,7 @@ subroutine final_restart() status = nf90_close(ncid) if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,idate #else call abort_ice(subname//'ERROR: USE_NETCDF cpp not defined', & 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 7e16f2591..72a1ed97f 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -41,8 +41,8 @@ subroutine ice_write_hist (ns) use ice_blocks, only: nx_block, ny_block use ice_broadcast, only: broadcast_scalar - use ice_calendar, only: time, sec, idate, idate0, write_ic, & - histfreq, dayyr, days_per_year, use_leap_years + use ice_calendar, only: msec, timesecs, idate, idate0, write_ic, & + histfreq, days_per_year, use_leap_years, dayyr use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c360, spval, spval_dbl use ice_domain, only: distrb_info, nblocks @@ -76,7 +76,6 @@ subroutine ice_write_hist (ns) character (char_len_long) :: ncfile(max_nstrm) integer (kind=int_kind) :: iotype - integer (kind=int_kind) :: iyear, imonth, iday integer (kind=int_kind) :: icategory,ind,i_aice,boundid character (char_len) :: start_time,current_date,current_time @@ -176,8 +175,8 @@ subroutine ice_write_hist (ns) call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) - ltime2 = time/int(secday) - ltime = real(time/int(secday),kind=real_kind) + ltime2 = timesecs/secday + ltime = real(timesecs/secday,kind=real_kind) ! option of turning on double precision history files lprecision = pio_real @@ -861,16 +860,16 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,pio_global,'source',trim(title)) if (use_leap_years) then - write(title,'(a,i3,a)') 'This year has ',int(dayyr),' days' + write(title,'(a,i3,a)') 'This year has ',dayyr,' days' else - write(title,'(a,i3,a)') 'All years have exactly ',int(dayyr),' days' + write(title,'(a,i3,a)') 'All years have exactly ',dayyr,' days' endif status = pio_put_att(File,pio_global,'comment',trim(title)) write(title,'(a,i8.8)') 'File written on model date ',idate status = pio_put_att(File,pio_global,'comment2',trim(title)) - write(title,'(a,i6)') 'seconds elapsed into model date: ',sec + write(title,'(a,i6)') 'seconds elapsed into model date: ',msec status = pio_put_att(File,pio_global,'comment3',trim(title)) title = 'CF-1.0' diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index eb703abcd..12d5d8e71 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -41,8 +41,8 @@ module ice_restart subroutine init_restart_read(ice_ic) - use ice_calendar, only: istep0, istep1, time, time_forc, nyr, month, & - mday, sec, npt + use ice_calendar, only: istep0, istep1, myear, mmonth, & + mday, msec, npt use ice_communicate, only: my_task, master_task use ice_domain_size, only: ncat use ice_read_write, only: ice_open @@ -54,7 +54,7 @@ subroutine init_restart_read(ice_ic) character(len=char_len_long) :: & filename, filename0 - integer (kind=int_kind) :: status + integer (kind=int_kind) :: status, status1 integer (kind=int_kind) :: iotype @@ -87,28 +87,40 @@ subroutine init_restart_read(ice_ic) call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) if (use_restart_time) then - status = pio_get_att(File, pio_global, 'istep1', istep0) - status = pio_get_att(File, pio_global, 'time', time) - status = pio_get_att(File, pio_global, 'time_forc', time_forc) - call pio_seterrorhandling(File, PIO_BCAST_ERROR) - status = pio_get_att(File, pio_global, 'nyr', nyr) - call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) - if (status == PIO_noerr) then - status = pio_get_att(File, pio_global, 'month', month) + status1 = PIO_noerr + status = pio_get_att(File, pio_global, 'istep1', istep0) +! status = pio_get_att(File, pio_global, 'time', time) +! status = pio_get_att(File, pio_global, 'time_forc', time_forc) + call pio_seterrorhandling(File, PIO_BCAST_ERROR) + status = pio_get_att(File, pio_global, 'myear', myear) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'nyr', myear) + if (status /= PIO_noerr) status1 = status + status = pio_get_att(File, pio_global, 'mmonth', mmonth) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'month', mmonth) + if (status /= PIO_noerr) status1 = status status = pio_get_att(File, pio_global, 'mday', mday) - status = pio_get_att(File, pio_global, 'sec', sec) - endif + if (status /= PIO_noerr) status1 = status + status = pio_get_att(File, pio_global, 'msec', msec) + if (status /= PIO_noerr) status = pio_get_att(File, pio_global, 'sec', msec) + if (status /= PIO_noerr) status1 = status + if (status1 /= PIO_noerr) & + call abort_ice(subname//"ERROR: reading restart time ") + call pio_seterrorhandling(File, PIO_INTERNAL_ERROR) endif ! use namelist values if use_restart_time = F ! endif if (my_task == master_task) then - write(nu_diag,*) 'Restart read at istep=',istep0,time,time_forc + write(nu_diag,*) 'Restart read at istep=',istep0,myear,mmonth,mday,msec endif call broadcast_scalar(istep0,master_task) - call broadcast_scalar(time,master_task) - call broadcast_scalar(time_forc,master_task) - call broadcast_scalar(nyr,master_task) + call broadcast_scalar(myear,master_task) + call broadcast_scalar(mmonth,master_task) + call broadcast_scalar(mday,master_task) + call broadcast_scalar(msec,master_task) +! call broadcast_scalar(time,master_task) +! call broadcast_scalar(time_forc,master_task) + call broadcast_scalar(myear,master_task) istep1 = istep0 @@ -126,8 +138,7 @@ end subroutine init_restart_read subroutine init_restart_write(filename_spec) - use ice_calendar, only: sec, month, mday, nyr, istep1, & - time, time_forc, year_init + use ice_calendar, only: msec, mmonth, mday, myear, istep1 use ice_communicate, only: my_task, master_task use ice_domain_size, only: nx_global, ny_global, ncat, nilyr, nslyr, & n_iso, n_aero, nblyr, n_zaero, n_algae, n_doc, & @@ -155,9 +166,6 @@ subroutine init_restart_write(filename_spec) ! local variables - integer (kind=int_kind) :: & - iyear, imonth, iday ! year, month, day - character(len=char_len_long) :: filename integer (kind=int_kind) :: dimid_ni, dimid_nj, dimid_ncat, & @@ -196,14 +204,10 @@ subroutine init_restart_write(filename_spec) if (present(filename_spec)) then filename = trim(filename_spec) else - iyear = nyr + year_init - 1 - imonth = month - iday = mday - 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)),'.', & - iyear,'-',month,'-',mday,'-',sec + myear,'-',mmonth,'-',mday,'-',msec end if if (restart_format(1:3) /= 'bin') filename = trim(filename) // '.nc' @@ -224,12 +228,12 @@ subroutine init_restart_write(filename_spec) clobber=.true., cdf64=lcdf64, iotype=iotype) status = pio_put_att(File,pio_global,'istep1',istep1) - status = pio_put_att(File,pio_global,'time',time) - status = pio_put_att(File,pio_global,'time_forc',time_forc) - status = pio_put_att(File,pio_global,'nyr',nyr) - status = pio_put_att(File,pio_global,'month',month) +! status = pio_put_att(File,pio_global,'time',time) +! status = pio_put_att(File,pio_global,'time_forc',time_forc) + status = pio_put_att(File,pio_global,'myear',myear) + status = pio_put_att(File,pio_global,'mmonth',mmonth) status = pio_put_att(File,pio_global,'mday',mday) - status = pio_put_att(File,pio_global,'sec',sec) + status = pio_put_att(File,pio_global,'msec',msec) status = pio_def_dim(File,'ni',nx_global,dimid_ni) status = pio_def_dim(File,'nj',ny_global,dimid_nj) @@ -702,7 +706,7 @@ subroutine read_restart_field(nu,nrec,work,atype,vname,ndim3,diag, & status = pio_inq_varid(File,trim(vname),vardesc) - if (status /= 0) then + if (status /= PIO_noerr) then call abort_ice(subname//"ERROR: CICE restart? Missing variable: "//trim(vname)) endif @@ -854,7 +858,7 @@ end subroutine write_restart_field subroutine final_restart() - use ice_calendar, only: istep1, time, time_forc + use ice_calendar, only: istep1, idate, msec use ice_communicate, only: my_task, master_task character(len=*), parameter :: subname = '(final_restart)' @@ -864,7 +868,7 @@ subroutine final_restart() call pio_closefile(File) if (my_task == master_task) & - write(nu_diag,*) 'Restart read/written ',istep1,time,time_forc + write(nu_diag,*) 'Restart read/written ',istep1,idate,msec end subroutine final_restart diff --git a/cicecore/drivers/direct/hadgem3/CICE.F90 b/cicecore/drivers/direct/hadgem3/CICE.F90 index e444dcd40..b2314240c 100644 --- a/cicecore/drivers/direct/hadgem3/CICE.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE.F90 @@ -56,40 +56,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_domain, only: nblocks - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - - ! local - integer (kind=int_kind) :: i, j, iblk - - if (istep1 >= check_step) then - - do iblk = 1, nblocks - do j = 1, ny_block - do i = 1, nx_block - if (iblk==iblkp .and. i==ip .and. j==jp .and. my_task==mtask) & - call print_state(plabeld,i,j,iblk) - enddo - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 index 397950023..2fdb170f1 100644 --- a/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 +++ b/cicecore/drivers/direct/hadgem3/CICE_FinalMod.F90 @@ -48,12 +48,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -63,31 +57,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - use ice_communicate, only: my_task, master_task - - character(len=char_len_long) :: filename - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 index 943787498..0be3636f0 100644 --- a/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_FinalMod.F90 @@ -45,12 +45,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -60,31 +54,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 index da745d965..c3de87f68 100644 --- a/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_InitMod.F90 @@ -64,7 +64,7 @@ subroutine cice_init(mpicom_ice) floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & init_calendar, calendar use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags @@ -156,7 +156,7 @@ subroutine cice_init(mpicom_ice) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - call calendar(time) ! determine the initial date + call calendar ! determine the initial date call init_forcing_ocn(dt) ! initialize sss and sst from data call init_state ! initialize the ice state @@ -233,7 +233,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + 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 @@ -295,7 +295,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 index d53014b7b..e9ab0d7e4 100644 --- a/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 +++ b/cicecore/drivers/mct/cesm1/CICE_RunMod.F90 @@ -44,7 +44,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, calendar, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -81,12 +81,14 @@ subroutine CICE_Run ! call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date ! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance timestep and update calendar data + call ice_timer_start(timer_couple) ! atm/ocn coupling ! for standalone @@ -108,7 +110,7 @@ subroutine CICE_Run call init_flux_atm ! Initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - call calendar(time) ! at the end of the timestep +! call calendar(time) ! at the end of the timestep call ice_timer_stop(timer_couple) ! atm/ocn coupling @@ -136,7 +138,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, sec + use ice_calendar, only: idate, msec use ice_diagnostics, only: init_mass_diags, runtime_diags use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks @@ -207,7 +209,7 @@ subroutine ice_step if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) + call ice_prescribed_run(idate, msec) call t_stopf ('cice_run_presc') endif diff --git a/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 b/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 index 8ae80abdc..08681d84f 100644 --- a/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 +++ b/cicecore/drivers/mct/cesm1/ice_comp_esmf.F90 @@ -48,10 +48,10 @@ module ice_comp_esmf use ice_constants, only : c0, c1, spval_dbl, rad_to_deg, radius, secday use ice_communicate, only : my_task, master_task, MPI_COMM_ICE use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& - idate, idate0, mday, time, month, daycal, & - sec, dt, dt_dyn, calendar, & + idate, idate0, mday, time, mmonth, & + msec, dt, dt_dyn, calendar, & calendar_type, nextsw_cday, days_per_year, & - nyr, new_year, time2sec, year_init + myear, new_year, time2sec, year_init use icepack_orbital, only : eccen, obliqr, lambm0, mvelpp use ice_timers @@ -178,12 +178,11 @@ subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) integer :: ref_ymd ! Reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (s) integer :: iyear ! yyyy - integer :: nyrp ! yyyy + integer :: myearp ! yyyy integer :: dtime ! time step integer :: shrlogunit,shrloglev ! old values integer :: iam,ierr integer :: lbnum - integer :: daycal(13) !number of cumulative days per month integer :: nleaps ! number of leap days before current year integer :: mpicom_loc, mpicom_vm, gsize integer :: nfields @@ -367,17 +366,17 @@ subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) endif iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + mmonth= (idate-iyear*10000)/100 ! integer month of basedate + mday = idate-iyear*10000-mmonth*100 ! day of month of basedate if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,mmonth,mday,start_tod endif - call time2sec(iyear,month,mday,time) + call time2sec(iyear,mmonth,mday,time) time = time+start_tod call shr_sys_flush(nu_diag) @@ -641,7 +640,7 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) integer :: curr_tod ! Current time of day (s) integer :: shrlogunit,shrloglev ! old values integer :: lbnum - integer :: n, nyrp + integer :: n, myearp type(ESMF_Array) :: i2x, x2i real(R8), pointer :: fptr(:,:) character(len=*), parameter :: subname = '(ice_run_esmf)' @@ -695,9 +694,9 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) if (calendar_type .eq. "GREGORIAN") then - nyrp = nyr - nyr = (curr_ymd/10000)+1 ! integer year of basedate - if (nyr /= nyrp) then + myearp = myear + myear = (curr_ymd/10000)+1 ! integer year of basedate + if (myear /= myearp) then new_year = .true. else new_year = .false. @@ -758,7 +757,7 @@ subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) ! check that internal clock is in sync with master clock !-------------------------------------------------------------------- - tod = sec + tod = msec ymd = idate if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & diff --git a/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 b/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 index 7162d6397..64dff54e2 100644 --- a/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 +++ b/cicecore/drivers/mct/cesm1/ice_comp_mct.F90 @@ -47,10 +47,9 @@ module ice_comp_mct use ice_constants, only : ice_init_constants use ice_communicate, only : my_task, master_task, MPI_COMM_ICE use ice_calendar, only : istep, istep1, force_restart_now, write_ic,& - idate, idate0, mday, time, month, daycal, & - sec, dt, dt_dyn, calendar, & - calendar_type, nextsw_cday, days_per_year, & - nyr, new_year, time2sec, year_init + idate, idate0, mday, mmonth, myear, & + msec, dt, dt_dyn, calendar, & + calendar_type, nextsw_cday, days_per_year use ice_timers use ice_kinds_mod, only : int_kind, dbl_kind, char_len_long, log_kind @@ -151,13 +150,11 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) integer :: curr_tod ! Current time of day (s) integer :: ref_ymd ! Reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (s) - integer :: iyear ! yyyy - integer :: nyrp ! yyyy + integer :: myearp ! yyyy integer :: dtime ! time step integer :: shrlogunit,shrloglev ! old values integer :: iam,ierr integer :: lbnum - integer :: daycal(13) !number of cumulative days per month integer :: nleaps ! number of leap days before current year integer :: mpicom_loc ! temporary mpicom logical (kind=log_kind) :: atm_aero, tr_aero, tr_zaero @@ -302,10 +299,9 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) ! - on restart run ! - istep0, time and time_forc are read from restart file ! - istep1 is set to istep0 - ! - idate is determined from time via the call to calendar (see below) + ! - date information is determined from restart ! - on initial run - ! - iyear, month and mday obtained from sync clock - ! - time determined from iyear, month and mday + ! - myear, mmonth, mday, msec obtained from sync clock ! - istep0 and istep1 are set to 0 call seq_timemgr_EClockGetData(EClock, & @@ -335,37 +331,26 @@ subroutine ice_init_mct( EClock, cdata_i, x2i_i, i2x_i, NLFilename ) idate0 = curr_ymd idate = curr_ymd -! idate0 = curr_ymd - (year_init*10000) -! idate = curr_ymd - (year_init*10000) - if (idate < 0) then - write(nu_diag,*) trim(subname),' ERROR curr_ymd,year_init =',curr_ymd,year_init + write(nu_diag,*) trim(subname),' ERROR curr_ymd =',curr_ymd write(nu_diag,*) trim(subname),' ERROR idate lt zero',idate call shr_sys_abort(subname//' :: ERROR idate lt zero') endif - iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + myear = (idate/10000) ! integer year of basedate + mmonth= (idate-myear*10000)/100 ! integer month of basedate + mday = idate-myear*10000-mmonth*100 ! day of month of basedate + msec = start_tod ! seconds if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd - write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',myear,mmonth,mday,start_tod endif - if (calendar_type /= "GREGORIAN") then - call time2sec(iyear-year_init,month,mday,time) - else - call time2sec(iyear-(year_init-1),month,mday,time) - endif - - time = time+start_tod - call shr_sys_flush(nu_diag) end if - call calendar(time) ! update calendar info + call calendar ! update calendar info if (write_ic) call accum_hist(dt) ! write initial conditions !--------------------------------------------------------------------------- @@ -527,7 +512,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) integer :: curr_tod ! Current time of day (s) integer :: shrlogunit,shrloglev ! old values integer :: lbnum - integer :: n, nyrp + integer :: n, myearp type(mct_gGrid) , pointer :: dom_i type(seq_infodata_type), pointer :: infodata type(mct_gsMap) , pointer :: gsMap_i @@ -580,9 +565,9 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) force_restart_now = seq_timemgr_RestartAlarmIsOn(EClock) ! if (calendar_type .eq. "GREGORIAN") then -! nyrp = nyr -! nyr = (curr_ymd/10000)+1 ! integer year of basedate -! if (nyr /= nyrp) then +! myearp = myear +! myear = (curr_ymd/10000)+1 ! integer year of basedate +! if (myear /= myearp) then ! new_year = .true. ! else ! new_year = .false. @@ -632,7 +617,7 @@ subroutine ice_run_mct( EClock, cdata_i, x2i_i, i2x_i ) ! check that internal clock is in sync with master clock !-------------------------------------------------------------------- - tod = sec + tod = msec ymd = idate if (.not. seq_timemgr_EClockDateInSync( EClock, ymd, tod )) then call seq_timemgr_EClockGetData( EClock, curr_ymd=ymd_sync, & diff --git a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 index 4debdfa55..e068a2892 100644 --- a/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 +++ b/cicecore/drivers/mct/cesm1/ice_prescribed_mod.F90 @@ -42,7 +42,7 @@ module ice_prescribed_mod use ice_blocks, only : nx_block, ny_block, block, get_block use ice_domain, only : nblocks, distrb_info, blocks_ice use ice_grid, only : TLAT,TLON,hm,tmask - use ice_calendar, only : idate, sec, calendar_type + use ice_calendar, only : idate, calendar_type use ice_arrays_column, only : hin_max use ice_read_write use ice_exit, only: abort_ice diff --git a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 index 943787498..0be3636f0 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_FinalMod.F90 @@ -45,12 +45,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -60,31 +54,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index b37d73f65..a57f8aef8 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -45,8 +45,9 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps + use ice_calendar, only: calendar use ice_communicate, only: my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks @@ -130,8 +131,7 @@ subroutine cice_init call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - - call calendar(time) ! determine the initial date + call calendar() ! determine the initial date ! TODO: - why is this being called when you are using CMEPS? call init_forcing_ocn(dt) ! initialize sss and sst from data @@ -192,7 +192,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + 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 @@ -254,7 +254,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 644ef72fa..3daa7e192 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -44,7 +44,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, calendar, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -77,18 +77,16 @@ subroutine CICE_Run ! timestep loop !-------------------------------------------------------------------- - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call ice_timer_start(timer_couple) ! atm/ocn coupling + call advance_timestep() ! advance timestep and update calendar data + if (z_tracers) call get_atm_bgc ! biogeochemistry call init_flux_atm ! Initialize atmosphere fluxes sent to coupler call init_flux_ocn ! initialize ocean fluxes sent to coupler - call calendar(time) ! at the end of the timestep + call calendar() ! at the end of the timestep call ice_timer_stop(timer_couple) ! atm/ocn coupling @@ -113,7 +111,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_calendar, only: idate, sec + use ice_calendar, only: idate, msec use ice_diagnostics, only: init_mass_diags, runtime_diags use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks @@ -185,7 +183,7 @@ subroutine ice_step if (prescribed_ice) then ! read prescribed ice call t_barrierf('cice_run_presc_BARRIER',MPI_COMM_ICE) call t_startf ('cice_run_presc') - call ice_prescribed_run(idate, sec) + call ice_prescribed_run(idate, msec) call t_stopf ('cice_run_presc') endif #endif diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index da3d95369..ebfc3d674 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -29,13 +29,13 @@ module ice_comp_nuopc use ice_grid , only : tlon, tlat, hm, tarea, ULON, ULAT use ice_communicate , only : init_communicate, my_task, master_task, mpi_comm_ice use ice_calendar , only : force_restart_now, write_ic - use ice_calendar , only : idate, mday, time, month, daycal, time2sec, year_init - use ice_calendar , only : sec, dt, calendar, calendar_type, nextsw_cday, istep + use ice_calendar , only : idate, mday, mmonth, year_init, timesecs + use ice_calendar , only : msec, dt, calendar, calendar_type, nextsw_cday, istep use ice_kinds_mod , only : dbl_kind, int_kind, char_len, char_len_long use ice_scam , only : scmlat, scmlon, single_column use ice_fileunits , only : nu_diag, nu_diag_set, inst_index, inst_name use ice_fileunits , only : inst_suffix, release_all_fileunits, flush_fileunit - use ice_restart_shared , only : runid, runtype, restart_dir, restart_file + use ice_restart_shared , only : runid, runtype, restart, use_restart_time, restart_dir, restart_file use ice_history , only : accum_hist use CICE_InitMod , only : cice_init use CICE_RunMod , only : cice_run @@ -395,7 +395,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) Tocnfrz_in = -34.0_dbl_kind*0.054_dbl_kind, & pi_in = SHR_CONST_PI, & snowpatch_in = 0.005_dbl_kind, & - dragio_in = 0.00962_dbl_kind) + dragio_in = 0.00536_dbl_kind) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & @@ -422,8 +422,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) runtype = "initial" else if (trim(starttype) == trim('continue') ) then runtype = "continue" + restart = .true. + use_restart_time = .true. else if (trim(starttype) == trim('branch')) then runtype = "continue" + restart = .true. + use_restart_time = .true. else call abort_ice( subname//' ERROR: unknown starttype' ) end if @@ -514,12 +518,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) - call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="diro", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(cvalue) end if - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diag_filename = trim(diag_filename) // '/' // trim(cvalue) @@ -600,14 +606,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call abort_ice(subname//' :: ERROR idate lt zero') endif iyear = (idate/10000) ! integer year of basedate - month = (idate-iyear*10000)/100 ! integer month of basedate - mday = idate-iyear*10000-month*100 ! day of month of basedate + mmonth= (idate-iyear*10000)/100 ! integer month of basedate + mday = idate-iyear*10000-mmonth*100 ! day of month of basedate if (my_task == master_task) then write(nu_diag,*) trim(subname),' curr_ymd = ',curr_ymd write(nu_diag,*) trim(subname),' cice year_init = ',year_init write(nu_diag,*) trim(subname),' cice start date = ',idate - write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,month,mday,start_tod + write(nu_diag,*) trim(subname),' cice start ymds = ',iyear,mmonth,mday,start_tod write(nu_diag,*) trim(subname),' cice calendar_type = ',trim(calendar_type) endif @@ -615,15 +621,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (calendar_type == "GREGORIAN" .or. & calendar_type == "Gregorian" .or. & calendar_type == "gregorian") then - call time2sec(iyear-(year_init-1),month,mday,time) + call time2sec(iyear-(year_init-1),mmonth,mday,time) else - call time2sec(iyear-year_init,month,mday,time) + call time2sec(iyear-year_init,mmonth,mday,time) endif #endif - time = time+start_tod + timesecs = timesecs+start_tod end if - call calendar(time) ! update calendar info + call calendar() ! update calendar info if (write_ic) then call accum_hist(dt) ! write initial conditions end if @@ -878,7 +884,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! TODO (mvertens, 2018-12-21): fill in iceberg_prognostic as .false. if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) end if !-------------------------------- @@ -1019,7 +1025,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- ! cice clock - tod = sec + tod = msec ymd = idate ! model clock @@ -1080,7 +1086,7 @@ subroutine ModelAdvance(gcomp, rc) ! write Debug output if (debug_import > 0 .and. my_task==master_task) then call State_fldDebug(importState, flds_scalar_name, 'cice_import:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug > 0) then @@ -1107,7 +1113,7 @@ subroutine ModelAdvance(gcomp, rc) ! write Debug output if (debug_export > 0 .and. my_task==master_task) then call State_fldDebug(exportState, flds_scalar_name, 'cice_export:', & - idate, sec, nu_diag, rc=rc) + idate, msec, nu_diag, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug > 0) then diff --git a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 index 78ea39b4e..6eca4f2b4 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_prescribed_mod.F90 @@ -47,7 +47,7 @@ end subroutine ice_prescribed_init use ice_blocks , only : nx_block, ny_block, block, get_block use ice_domain , only : nblocks, distrb_info, blocks_ice use ice_grid , only : TLAT, TLON, hm, tmask, tarea, grid_type, ocn_gridcell_frac - use ice_calendar , only : idate, sec, calendar_type + use ice_calendar , only : idate, calendar_type use ice_arrays_column , only : hin_max use ice_read_write use ice_exit , only: abort_ice diff --git a/cicecore/drivers/nuopc/dmi/CICE.F90 b/cicecore/drivers/nuopc/dmi/CICE.F90 index 2fd0c9f88..7056e0e5b 100644 --- a/cicecore/drivers/nuopc/dmi/CICE.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE.F90 @@ -57,39 +57,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(iblk, plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - integer (kind=int_kind), intent(in) :: iblk - - ! local - integer (kind=int_kind) :: i, j - character(len=*), parameter :: subname='(debug_ice)' - - if (istep1 >= check_step .and. & - iblk==iblkp .and. my_task==mtask) then - - do j = 1, ny_block - do i = 1, nx_block - if (i==ip .and. j==jp) call print_state(plabeld,i,j,iblk) - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 index 9e2681dbb..9f32875e1 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_FinalMod.F90 @@ -35,9 +35,9 @@ subroutine CICE_Finalize character(len=*), parameter :: subname = '(CICE_Finalize)' - !------------------------------------------------------------------- - ! stop timers and print timer info - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! stop timers and print timer info + !------------------------------------------------------------------- call ice_timer_stop(timer_total) ! stop timing entire run call ice_timer_print_all(stats=.false.) ! print timing information @@ -55,15 +55,9 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - - !------------------------------------------------------------------- - ! quit MPI - !------------------------------------------------------------------- + !------------------------------------------------------------------- + ! quit MPI + !------------------------------------------------------------------- #ifndef coupled #ifndef CICE_DMI @@ -72,31 +66,6 @@ subroutine CICE_Finalize #endif end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 index 70ef5f895..625348863 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_InitMod.F90 @@ -46,9 +46,9 @@ subroutine CICE_Initialize(mpi_comm) integer (kind=int_kind), optional, intent(in) :: mpi_comm ! communicator from nuopc character(len=*), parameter :: subname='(CICE_Initialize)' - !-------------------------------------------------------------------- - ! model initialization - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! model initialization + !-------------------------------------------------------------------- if (present(mpi_comm)) then call cice_init(mpi_comm) @@ -69,14 +69,15 @@ subroutine cice_init(mpi_comm) floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks use ice_domain_size, only: ncat, nfsd use ice_dyn_eap, only: init_eap, alloc_dyn_eap use ice_dyn_shared, only: kdyn, init_dyn, alloc_dyn_shared + use ice_dyn_vp, only: init_vp 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, & @@ -87,7 +88,8 @@ subroutine cice_init(mpi_comm) use ice_history, only: init_hist, accum_hist use ice_restart_shared, only: restart, runtype use ice_init, only: input_data, init_state - use ice_init_column, only: init_thermo_vertical, init_shortwave, init_zbgc, input_zbgc, count_tracers + use ice_init_column, only: init_thermo_vertical, init_shortwave, & + init_zbgc, input_zbgc, count_tracers use ice_kinds_mod use ice_restoring, only: ice_HaloRestore_init use ice_timers, only: timer_total, init_ice_timers, ice_timer_start @@ -166,9 +168,6 @@ subroutine cice_init(mpi_comm) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -#ifndef CICE_DMI - call calendar(time) ! determine the initial date -#endif #ifndef CICE_IN_NEMO call init_forcing_ocn(dt) ! initialize sss and sst from data #endif @@ -188,6 +187,7 @@ subroutine cice_init(mpi_comm) call init_diags ! initialize diagnostic output points call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso) @@ -204,10 +204,7 @@ subroutine cice_init(mpi_comm) if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call calendar(time) ! at the end of the first timestep + call advance_timestep() !-------------------------------------------------------------------- ! coupler communication or forcing data initialization @@ -252,7 +249,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + 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 @@ -314,7 +311,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 index df8fe4978..cfd519146 100644 --- a/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/dmi/CICE_RunMod.F90 @@ -43,7 +43,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -73,20 +73,16 @@ subroutine CICE_Run file=__FILE__, line=__LINE__) #ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- + !-------------------------------------------------------------------- + ! timestep loop + !-------------------------------------------------------------------- #ifndef CICE_DMI - timeLoop: do + timeLoop: do #endif #endif call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time #ifndef CICE_IN_NEMO #ifndef CICE_DMI @@ -361,8 +357,8 @@ subroutine coupling_prep (iblk) albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, fswthru, scale_factor, snowfrac, & - fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & + fswthru_ai, fhocn, scale_factor, snowfrac, & + fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & fsens, flat, fswabs, flwout, evap, Tref, Qref, & scale_fluxes, frzmlt_init, frzmlt @@ -556,11 +552,12 @@ subroutine coupling_prep (iblk) evap (:,:,iblk), & Tref (:,:,iblk), Qref (:,:,iblk), & fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), fswthru (:,:,iblk), & - fswthru_vdr(:,:,iblk), & - fswthru_vdf(:,:,iblk), & - fswthru_idr(:,:,iblk), & - fswthru_idf(:,:,iblk), & + fhocn (:,:,iblk), & + fswthru (:,:,iblk), & + fswthru_vdr (:,:,iblk), & + fswthru_vdf (:,:,iblk), & + fswthru_idr (:,:,iblk), & + fswthru_idf (:,:,iblk), & faero_ocn(:,:,:,iblk), & alvdr (:,:,iblk), alidr (:,:,iblk), & alvdf (:,:,iblk), alidf (:,:,iblk), & @@ -635,11 +632,12 @@ subroutine sfcflux_to_ocn(nx_block, ny_block, & real (kind=dbl_kind) :: & puny, & ! + Lsub, & ! rLsub ! 1/Lsub character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) diff --git a/cicecore/drivers/standalone/cice/CICE.F90 b/cicecore/drivers/standalone/cice/CICE.F90 index 2fd0c9f88..7056e0e5b 100644 --- a/cicecore/drivers/standalone/cice/CICE.F90 +++ b/cicecore/drivers/standalone/cice/CICE.F90 @@ -57,39 +57,3 @@ program icemodel end program icemodel !======================================================================= -! -! Wrapper for the print_state debugging routine. -! Useful for debugging in the main driver (see ice.F_debug) -! ip, jp, mtask are set in ice_diagnostics.F -! -! author Elizabeth C. Hunke, LANL -! - subroutine debug_ice(iblk, plabeld) - - use ice_kinds_mod - use ice_calendar, only: istep1 - use ice_communicate, only: my_task - use ice_diagnostics, only: check_step, iblkp, ip, jp, mtask, print_state - use ice_blocks, only: nx_block, ny_block - - character (char_len), intent(in) :: plabeld - integer (kind=int_kind), intent(in) :: iblk - - ! local - integer (kind=int_kind) :: i, j - character(len=*), parameter :: subname='(debug_ice)' - - if (istep1 >= check_step .and. & - iblk==iblkp .and. my_task==mtask) then - - do j = 1, ny_block - do i = 1, nx_block - if (i==ip .and. j==jp) call print_state(plabeld,i,j,iblk) - enddo - enddo - - endif - - end subroutine debug_ice - -!======================================================================= diff --git a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 index dd0ca0b20..a59c210aa 100644 --- a/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_FinalMod.F90 @@ -55,12 +55,6 @@ subroutine CICE_Finalize !echmod if (nu_diag /= 6) close (nu_diag) ! diagnostic output call release_all_fileunits - !------------------------------------------------------------------- - ! write 'finished' file if needed - !------------------------------------------------------------------- - - if (runid == 'bering') call writeout_finished_file() - !------------------------------------------------------------------- ! quit MPI !------------------------------------------------------------------- @@ -69,31 +63,6 @@ subroutine CICE_Finalize end subroutine CICE_Finalize -!======================================================================= -! -! Write a file indicating that this run finished cleanly. This is -! needed only for runs on machine 'bering' (set using runid = 'bering'). -! -! author: Adrian Turner, LANL - - subroutine writeout_finished_file() - - use ice_restart_shared, only: restart_dir - - character(len=char_len_long) :: filename - character(len=*), parameter :: subname = '(writeout_finished_file)' - - if (my_task == master_task) then - - filename = trim(restart_dir)//"finished" - open(11,file=filename) - write(11,*) "finished" - close(11) - - endif - - end subroutine writeout_finished_file - !======================================================================= end module CICE_FinalMod diff --git a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 index 8b507740d..60f71fa8a 100644 --- a/cicecore/drivers/standalone/cice/CICE_InitMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_InitMod.F90 @@ -64,8 +64,8 @@ subroutine cice_init floe_binwidth, c_fsd_range use ice_state, only: alloc_state use ice_flux_bgc, only: alloc_flux_bgc - use ice_calendar, only: dt, dt_dyn, time, istep, istep1, write_ic, & - init_calendar, calendar + use ice_calendar, only: dt, dt_dyn, istep, istep1, write_ic, & + init_calendar, advance_timestep, calc_timesteps use ice_communicate, only: init_communicate, my_task, master_task use ice_diagnostics, only: init_diags use ice_domain, only: init_domain_blocks @@ -156,8 +156,6 @@ subroutine cice_init if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) -! 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 @@ -175,6 +173,7 @@ subroutine cice_init call init_diags ! initialize diagnostic output points call init_history_therm ! initialize thermo history variables call init_history_dyn ! initialize dynamic history variables + call calc_timesteps ! update timestep counter if not using npt_unit="1" call icepack_query_tracer_flags(tr_aero_out=tr_aero, tr_zaero_out=tr_zaero) call icepack_query_tracer_flags(tr_iso_out=tr_iso) @@ -191,10 +190,12 @@ subroutine cice_init if (trim(runtype) == 'continue' .or. restart) & call init_shortwave ! initialize radiative transfer - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - call calendar(time) ! at the end of the first timestep +! tcraig, use advance_timestep here +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the first timestep + call advance_timestep() !-------------------------------------------------------------------- ! coupler communication or forcing data initialization @@ -231,7 +232,7 @@ subroutine init_restart use ice_arrays_column, only: dhsn use ice_blocks, only: nx_block, ny_block - use ice_calendar, only: time, calendar + 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 @@ -293,7 +294,7 @@ subroutine init_restart if (trim(runtype) == 'continue') then ! start from core restart file call restartfile() ! given by pointer in ice_in - call calendar(time) ! update time parameters + call calendar() ! update time parameters if (kdyn == 2) call read_restart_eap ! EAP else if (restart) then ! ice_ic = core restart file call restartfile (ice_ic) ! or 'default' or 'none' diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 index 9f6f42f28..08059435f 100644 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90 +++ b/cicecore/drivers/standalone/cice/CICE_RunMod.F90 @@ -43,7 +43,7 @@ module CICE_RunMod subroutine CICE_Run - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar + use ice_calendar, only: istep, istep1, dt, stop_now, advance_timestep use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & get_wave_spec use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & @@ -82,11 +82,12 @@ subroutine CICE_Run call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep +! tcraig, use advance_timestep now +! istep = istep + 1 ! update time step counters +! istep1 = istep1 + 1 +! time = time + dt ! determine the time and date +! call calendar(time) ! at the end of the timestep + call advance_timestep() ! advance time #ifndef CICE_IN_NEMO if (stop_now >= 1) exit timeLoop @@ -137,7 +138,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_diagnostics, only: init_mass_diags, runtime_diags + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap @@ -175,6 +176,15 @@ subroutine ice_step character(len=*), parameter :: subname = '(ice_step)' + character (len=char_len) :: plabeld + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & wave_spec_out=wave_spec) @@ -218,14 +228,36 @@ subroutine ice_step if (calc_Tsfc) call prep_radiation (iblk) + if (debug_model) then + plabeld = 'post prep_radiation' + call debug_ice (iblk, plabeld) + endif + !----------------------------------------------------------------- ! thermodynamics and biogeochemistry !----------------------------------------------------------------- call step_therm1 (dt, iblk) ! vertical thermodynamics + + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + call biogeochemistry (dt, iblk) ! biogeochemistry + + if (debug_model) then + plabeld = 'post biogeochemistry' + call debug_ice (iblk, plabeld) + endif + call step_therm2 (dt, iblk) ! ice thickness distribution thermo + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif + endif ! ktherm > 0 enddo ! iblk @@ -251,6 +283,13 @@ subroutine ice_step ! momentum, stress, transport call step_dyn_horiz (dt_dyn) + if (debug_model) then + plabeld = 'post step_dyn_horiz' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + ! ridging !$OMP PARALLEL DO PRIVATE(iblk) do iblk = 1, nblocks @@ -258,12 +297,26 @@ subroutine ice_step enddo !$OMP END PARALLEL DO + if (debug_model) then + plabeld = 'post step_dyn_ridge' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif + ! clean up, update tendency diagnostics offset = c0 call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) enddo + if (debug_model) then + plabeld = 'post dynamics' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + !----------------------------------------------------------------- ! albedo, shortwave radiation !----------------------------------------------------------------- @@ -277,12 +330,22 @@ subroutine ice_step if (ktherm >= 0) call step_radiation (dt, iblk) + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif + !----------------------------------------------------------------- ! get ready for coupling and the next time step !----------------------------------------------------------------- call coupling_prep (iblk) + if (debug_model) then + plabeld = 'post coupling_prep' + call debug_ice (iblk, plabeld) + endif + enddo ! iblk !$OMP END PARALLEL DO @@ -627,11 +690,12 @@ subroutine sfcflux_to_ocn(nx_block, ny_block, & real (kind=dbl_kind) :: & puny, & ! + Lsub, & ! rLsub ! 1/Lsub character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) diff --git a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug b/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug deleted file mode 100644 index 5f7eebe31..000000000 --- a/cicecore/drivers/standalone/cice/CICE_RunMod.F90_debug +++ /dev/null @@ -1,704 +0,0 @@ -!======================================================================= -! -! Main driver for time stepping of CICE. -! -! authors Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL -! -! 2006 ECH: moved exit timeLoop to prevent execution of unnecessary timestep -! 2006 ECH: Streamlined for efficiency -! 2006 ECH: Converted to free source form (F90) -! 2007 BPB: Modified Delta-Eddington shortwave interface -! 2008 ECH: moved ESMF code to its own driver - - module CICE_RunMod - - use ice_kinds_mod - use ice_fileunits, only: nu_diag - use ice_arrays_column, only: oceanmixed_ice - use ice_constants, only: c0, c1 - use ice_constants, only: field_loc_center, field_type_scalar - use ice_exit, only: abort_ice - use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted - use icepack_intfc, only: icepack_max_iso, icepack_max_aero - use icepack_intfc, only: icepack_query_parameters - use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_sizes - - implicit none - private - public :: CICE_Run, ice_step - -!======================================================================= - - contains - -!======================================================================= -! -! This is the main driver routine for advancing CICE forward in time. -! -! author Elizabeth C. Hunke, LANL -! Philip W. Jones, LANL -! William H. Lipscomb, LANL - - subroutine CICE_Run - - use ice_calendar, only: istep, istep1, time, dt, stop_now, calendar - use ice_forcing, only: get_forcing_atmo, get_forcing_ocn, & - get_wave_spec - use ice_forcing_bgc, only: get_forcing_bgc, get_atm_bgc, & - fiso_default, faero_default - use ice_flux, only: init_flux_atm, init_flux_ocn - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_couple, timer_step - logical (kind=log_kind) :: & - tr_iso, tr_aero, tr_zaero, skl_bgc, z_tracers, wave_spec, tr_fsd - character(len=*), parameter :: subname = '(CICE_Run)' - - !-------------------------------------------------------------------- - ! initialize error code and step timer - !-------------------------------------------------------------------- - - call ice_timer_start(timer_step) ! start timing entire run - - call icepack_query_parameters(skl_bgc_out=skl_bgc, & - z_tracers_out=z_tracers, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_iso_out=tr_iso, & - tr_aero_out=tr_aero, & - tr_zaero_out=tr_zaero, & - tr_fsd_out=tr_fsd) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - -#ifndef CICE_IN_NEMO - !-------------------------------------------------------------------- - ! timestep loop - !-------------------------------------------------------------------- - - timeLoop: do -#endif - - call ice_step - - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date - - call calendar(time) ! at the end of the timestep - -#ifndef CICE_IN_NEMO - if (stop_now >= 1) exit timeLoop -#endif - - call ice_timer_start(timer_couple) ! atm/ocn coupling - -! for now, wave_spectrum is constant in time -! if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice - call get_forcing_atmo ! atmospheric forcing from data - call get_forcing_ocn(dt) ! ocean forcing from data - - ! isotopes - if (tr_iso) call fiso_default ! default values - ! aerosols - ! if (tr_aero) call faero_data ! data file - ! if (tr_zaero) call fzaero_data ! data file (gx1) - if (tr_aero .or. tr_zaero) call faero_default ! default values - - if (skl_bgc .or. z_tracers) call get_forcing_bgc ! biogeochemistry - if (z_tracers) call get_atm_bgc ! biogeochemistry - - call init_flux_atm ! Initialize atmosphere fluxes sent to coupler - call init_flux_ocn ! initialize ocean fluxes sent to coupler - - call ice_timer_stop(timer_couple) ! atm/ocn coupling - -#ifndef CICE_IN_NEMO - enddo timeLoop -#endif - - !-------------------------------------------------------------------- - ! end of timestep loop - !-------------------------------------------------------------------- - - call ice_timer_stop(timer_step) ! end timestepping loop timer - - end subroutine CICE_Run - -!======================================================================= -! -! Calls drivers for physics components, some initialization, and output -! -! author Elizabeth C. Hunke, LANL -! William H. Lipscomb, LANL - - subroutine ice_step - - use ice_boundary, only: ice_HaloUpdate - use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep - use ice_diagnostics, only: init_mass_diags, runtime_diags - use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags - use ice_domain, only: halo_info, nblocks - use ice_dyn_eap, only: write_restart_eap - use ice_dyn_shared, only: kdyn, kridge - use ice_flux, only: scale_factor, init_history_therm, & - daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd - use ice_history, only: accum_hist - use ice_history_bgc, only: init_history_bgc - use ice_restart, only: final_restart - use ice_restart_column, only: write_restart_age, write_restart_FY, & - write_restart_lvl, write_restart_pond_cesm, write_restart_pond_lvl, & - write_restart_pond_topo, write_restart_aero, write_restart_fsd, & - write_restart_iso, write_restart_bgc, write_restart_hbrine - 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 - use ice_timers, only: ice_timer_start, ice_timer_stop, & - timer_diags, timer_column, timer_thermo, timer_bound, & - timer_hist, timer_readwrite - - integer (kind=int_kind) :: & - iblk , & ! block index - k , & ! dynamics supercycling index - ktherm ! thermodynamics is off when ktherm = -1 - - real (kind=dbl_kind) :: & - offset ! d(age)/dt time offset - - logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_lvl, tr_fsd, & - tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_brine, tr_iso, tr_aero, & - calc_Tsfc, skl_bgc, solve_zsal, z_tracers, wave_spec - - character(len=*), parameter :: subname = '(ice_step)' - - character (len=char_len) :: plabeld - - plabeld = 'beginning time step' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & - solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & - wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_lvl_out=tr_lvl, tr_pond_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) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! restoring on grid boundaries - !----------------------------------------------------------------- - - if (restore_ice) call ice_HaloRestore - - !----------------------------------------------------------------- - ! initialize diagnostics and save initial state values - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics/history - call init_mass_diags ! diagnostics per timestep - call init_history_therm - call init_history_bgc - call ice_timer_stop(timer_diags) ! diagnostics/history - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - - call save_init - - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) then - - !----------------------------------------------------------------- - ! scale radiation fields - !----------------------------------------------------------------- - - if (calc_Tsfc) call prep_radiation (iblk) - - plabeld = 'post prep_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! thermodynamics and biogeochemistry - !----------------------------------------------------------------- - - call step_therm1 (dt, iblk) ! vertical thermodynamics - - plabeld = 'post step_therm1' - call debug_ice (iblk, plabeld) - - call biogeochemistry (dt, iblk) ! biogeochemistry - - plabeld = 'post biogeochemistry' - call debug_ice (iblk, plabeld) - - call step_therm2 (dt, iblk) ! ice thickness distribution thermo - - plabeld = 'post step_therm2' - call debug_ice (iblk, plabeld) - - endif ! ktherm > 0 - - enddo ! iblk - !$OMP END PARALLEL DO - - ! clean up, update tendency diagnostics - offset = dt - call update_state (dt, daidtt, dvidtt, dagedtt, offset) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! dynamics, transport, ridging - !----------------------------------------------------------------- - - ! wave fracture of the floe size distribution - ! note this is called outside of the dynamics subcycling loop - if (tr_fsd .and. wave_spec) call step_dyn_wave(dt) - - do k = 1, ndtd - - ! momentum, stress, transport - call step_dyn_horiz (dt_dyn) - - do iblk = 1, nblocks - plabeld = 'post step_dyn_horiz' - call debug_ice (iblk, plabeld) - enddo ! iblk - - ! ridging - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) - enddo - !$OMP END PARALLEL DO - - do iblk = 1, nblocks - plabeld = 'post step_dyn_ridge' - call debug_ice (iblk, plabeld) - enddo ! iblk - - ! clean up, update tendency diagnostics - offset = c0 - call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) - - enddo - - plabeld = 'post dynamics' - do iblk = 1, nblocks - call debug_ice (iblk, plabeld) - enddo - - !----------------------------------------------------------------- - ! albedo, shortwave radiation - !----------------------------------------------------------------- - - call ice_timer_start(timer_column) ! column physics - call ice_timer_start(timer_thermo) ! thermodynamics - -!MHRI: CHECK THIS OMP - !$OMP PARALLEL DO PRIVATE(iblk) - do iblk = 1, nblocks - - if (ktherm >= 0) call step_radiation (dt, iblk) - - plabeld = 'post step_radiation' - call debug_ice (iblk, plabeld) - - !----------------------------------------------------------------- - ! get ready for coupling and the next time step - !----------------------------------------------------------------- - - call coupling_prep (iblk) - - plabeld = 'post coupling_prep' - call debug_ice (iblk, plabeld) - - enddo ! iblk - !$OMP END PARALLEL DO - - call ice_timer_start(timer_bound) - call ice_HaloUpdate (scale_factor, halo_info, & - field_loc_center, field_type_scalar) - call ice_timer_stop(timer_bound) - - call ice_timer_stop(timer_thermo) ! thermodynamics - call ice_timer_stop(timer_column) ! column physics - - !----------------------------------------------------------------- - ! write data - !----------------------------------------------------------------- - - call ice_timer_start(timer_diags) ! diagnostics - if (mod(istep,diagfreq) == 0) then - call runtime_diags(dt) ! log file - if (solve_zsal) call zsal_diags - if (skl_bgc .or. z_tracers) call bgc_diags - if (tr_brine) call hbrine_diags - endif - call ice_timer_stop(timer_diags) ! diagnostics - - call ice_timer_start(timer_hist) ! history - call accum_hist (dt) ! history file - call ice_timer_stop(timer_hist) ! history - - call ice_timer_start(timer_readwrite) ! reading/writing - if (write_restart == 1) then - call dumpfile ! core variables for restarting - if (tr_iage) call write_restart_age - if (tr_FY) call write_restart_FY - if (tr_lvl) call write_restart_lvl - if (tr_pond_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_fsd) call write_restart_fsd - if (tr_iso) call write_restart_iso - if (tr_aero) call write_restart_aero - if (solve_zsal .or. skl_bgc .or. z_tracers) & - call write_restart_bgc - if (tr_brine) call write_restart_hbrine - if (kdyn == 2) call write_restart_eap - call final_restart - endif - - call ice_timer_stop(timer_readwrite) ! reading/writing - - end subroutine ice_step - -!======================================================================= -! -! Prepare for coupling -! -! authors: Elizabeth C. Hunke, LANL - - subroutine coupling_prep (iblk) - - use ice_arrays_column, only: alvdfn, alidfn, alvdrn, alidrn, & - albicen, albsnon, albpndn, apeffn, fzsal_g, fzsal, snowfracn - use ice_blocks, only: nx_block, ny_block, get_block, block - use ice_domain, only: blocks_ice - use ice_calendar, only: dt, nstreams - use ice_domain_size, only: ncat - use ice_flux, only: alvdf, alidf, alvdr, alidr, albice, albsno, & - albpnd, albcnt, apeff_ai, fpond, fresh, l_mpond_fresh, & - alvdf_ai, alidf_ai, alvdr_ai, alidr_ai, fhocn_ai, & - fresh_ai, fsalt_ai, fsalt, & - fswthru_ai, fhocn, scale_factor, snowfrac, & - fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf, & - swvdr, swidr, swvdf, swidf, Tf, Tair, Qa, strairxT, strairyT, & - fsens, flat, fswabs, flwout, evap, Tref, Qref, & - scale_fluxes, frzmlt_init, frzmlt - use ice_flux_bgc, only: faero_ocn, fiso_ocn, Qref_iso, fiso_evap, & - fzsal_ai, fzsal_g_ai, flux_bio, flux_bio_ai - use ice_grid, only: tmask - use ice_state, only: aicen, aice -#ifdef CICE_IN_NEMO - use ice_state, only: aice_init - use ice_flux, only: flatn_f, fsurfn_f -#endif - use ice_step_mod, only: ocean_mixed_layer - use ice_timers, only: timer_couple, ice_timer_start, ice_timer_stop - - integer (kind=int_kind), intent(in) :: & - iblk ! block index - - ! local variables - - integer (kind=int_kind) :: & - ilo,ihi,jlo,jhi, & ! beginning and end of physical domain - n , & ! thickness category index - i,j , & ! horizontal indices - k , & ! tracer index - nbtrcr ! - - type (block) :: & - this_block ! block information for current block - - logical (kind=log_kind) :: & - calc_Tsfc ! - - real (kind=dbl_kind) :: & - cszn , & ! counter for history averaging - puny , & ! - rhofresh , & ! - netsw ! flag for shortwave radiation presence - - character(len=*), parameter :: subname = '(coupling_prep)' - - call icepack_query_parameters(puny_out=puny, rhofresh_out=rhofresh) - call icepack_query_tracer_sizes(nbtrcr_out=nbtrcr) - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - !----------------------------------------------------------------- - ! Save current value of frzmlt for diagnostics. - ! Update mixed layer with heat and radiation from ice. - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - frzmlt_init (i,j,iblk) = frzmlt(i,j,iblk) - enddo - enddo - - call ice_timer_start(timer_couple) ! atm/ocn coupling - - if (oceanmixed_ice) & - call ocean_mixed_layer (dt,iblk) ! ocean surface fluxes and sst - - !----------------------------------------------------------------- - ! Aggregate albedos - !----------------------------------------------------------------- - - do j = 1, ny_block - do i = 1, nx_block - alvdf(i,j,iblk) = c0 - alidf(i,j,iblk) = c0 - alvdr(i,j,iblk) = c0 - alidr(i,j,iblk) = c0 - - albice(i,j,iblk) = c0 - albsno(i,j,iblk) = c0 - albpnd(i,j,iblk) = c0 - apeff_ai(i,j,iblk) = c0 - snowfrac(i,j,iblk) = c0 - - ! for history averaging - cszn = c0 - netsw = swvdr(i,j,iblk)+swidr(i,j,iblk)+swvdf(i,j,iblk)+swidf(i,j,iblk) - if (netsw > puny) cszn = c1 - do n = 1, nstreams - albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn - enddo - enddo - enddo - - this_block = get_block(blocks_ice(iblk),iblk) - ilo = this_block%ilo - ihi = this_block%ihi - jlo = this_block%jlo - jhi = this_block%jhi - - do n = 1, ncat - do j = jlo, jhi - do i = ilo, ihi - if (aicen(i,j,n,iblk) > puny) then - - alvdf(i,j,iblk) = alvdf(i,j,iblk) & - + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidf(i,j,iblk) = alidf(i,j,iblk) & - + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk) - alvdr(i,j,iblk) = alvdr(i,j,iblk) & - + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) - alidr(i,j,iblk) = alidr(i,j,iblk) & - + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - - netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & - + swvdf(i,j,iblk) + swidf(i,j,iblk) - if (netsw > puny) then ! sun above horizon - albice(i,j,iblk) = albice(i,j,iblk) & - + albicen(i,j,n,iblk)*aicen(i,j,n,iblk) - albsno(i,j,iblk) = albsno(i,j,iblk) & - + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk) - albpnd(i,j,iblk) = albpnd(i,j,iblk) & - + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) - endif - - apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & ! for history - + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) - snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & ! for history - + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - - endif ! aicen > puny - enddo - enddo - enddo - - do j = 1, ny_block - do i = 1, nx_block - - !----------------------------------------------------------------- - ! reduce fresh by fpond for coupling - !----------------------------------------------------------------- - - if (l_mpond_fresh) then - fpond(i,j,iblk) = fpond(i,j,iblk) * rhofresh/dt - fresh(i,j,iblk) = fresh(i,j,iblk) - fpond(i,j,iblk) - endif - - !---------------------------------------------------------------- - ! Store grid box mean albedos and fluxes before scaling by aice - !---------------------------------------------------------------- - - alvdf_ai (i,j,iblk) = alvdf (i,j,iblk) - alidf_ai (i,j,iblk) = alidf (i,j,iblk) - alvdr_ai (i,j,iblk) = alvdr (i,j,iblk) - alidr_ai (i,j,iblk) = alidr (i,j,iblk) - fresh_ai (i,j,iblk) = fresh (i,j,iblk) - fsalt_ai (i,j,iblk) = fsalt (i,j,iblk) - fhocn_ai (i,j,iblk) = fhocn (i,j,iblk) - fswthru_ai(i,j,iblk) = fswthru(i,j,iblk) - fzsal_ai (i,j,iblk) = fzsal (i,j,iblk) - fzsal_g_ai(i,j,iblk) = fzsal_g(i,j,iblk) - - if (nbtrcr > 0) then - do k = 1, nbtrcr - flux_bio_ai (i,j,k,iblk) = flux_bio (i,j,k,iblk) - enddo - endif - - !----------------------------------------------------------------- - ! Save net shortwave for scaling factor in scale_factor - !----------------------------------------------------------------- - scale_factor(i,j,iblk) = & - swvdr(i,j,iblk)*(c1 - alvdr_ai(i,j,iblk)) & - + swvdf(i,j,iblk)*(c1 - alvdf_ai(i,j,iblk)) & - + swidr(i,j,iblk)*(c1 - alidr_ai(i,j,iblk)) & - + swidf(i,j,iblk)*(c1 - alidf_ai(i,j,iblk)) - - enddo - enddo - - !----------------------------------------------------------------- - ! Divide fluxes by ice area - ! - the CESM coupler assumes fluxes are per unit ice area - ! - also needed for global budget in diagnostics - !----------------------------------------------------------------- - - call scale_fluxes (nx_block, ny_block, & - tmask (:,:,iblk), nbtrcr, & - icepack_max_aero, & - aice (:,:,iblk), Tf (:,:,iblk), & - Tair (:,:,iblk), Qa (:,:,iblk), & - strairxT (:,:,iblk), strairyT(:,:,iblk), & - fsens (:,:,iblk), flat (:,:,iblk), & - fswabs (:,:,iblk), flwout (:,:,iblk), & - evap (:,:,iblk), & - Tref (:,:,iblk), Qref (:,:,iblk), & - fresh (:,:,iblk), fsalt (:,:,iblk), & - fhocn (:,:,iblk), & - fswthru (:,:,iblk), & - fswthru_vdr (:,:,iblk), & - fswthru_vdf (:,:,iblk), & - fswthru_idr (:,:,iblk), & - fswthru_idf (:,:,iblk), & - faero_ocn(:,:,:,iblk), & - alvdr (:,:,iblk), alidr (:,:,iblk), & - alvdf (:,:,iblk), alidf (:,:,iblk), & - fzsal (:,:,iblk), fzsal_g (:,:,iblk), & - flux_bio (:,:,1:nbtrcr,iblk), & - Qref_iso =Qref_iso (:,:,:,iblk), & - fiso_evap=fiso_evap(:,:,:,iblk), & - fiso_ocn =fiso_ocn (:,:,:,iblk)) - -#ifdef CICE_IN_NEMO -!echmod - comment this out for efficiency, if .not. calc_Tsfc - if (.not. calc_Tsfc) then - - !--------------------------------------------------------------- - ! If surface fluxes were provided, conserve these fluxes at ice - ! free points by passing to ocean. - !--------------------------------------------------------------- - - call sfcflux_to_ocn & - (nx_block, ny_block, & - tmask (:,:,iblk), aice_init(:,:,iblk), & - fsurfn_f (:,:,:,iblk), flatn_f(:,:,:,iblk), & - fresh (:,:,iblk), fhocn (:,:,iblk)) - endif -!echmod -#endif - call ice_timer_stop(timer_couple) ! atm/ocn coupling - - end subroutine coupling_prep - -#ifdef CICE_IN_NEMO - -!======================================================================= -! -! If surface heat fluxes are provided to CICE instead of CICE calculating -! them internally (i.e. .not. calc_Tsfc), then these heat fluxes can -! be provided at points which do not have ice. (This is could be due to -! the heat fluxes being calculated on a lower resolution grid or the -! heat fluxes not recalculated at every CICE timestep.) At ice free points, -! conserve energy and water by passing these fluxes to the ocean. -! -! author: A. McLaren, Met Office - - subroutine sfcflux_to_ocn(nx_block, ny_block, & - tmask, aice, & - fsurfn_f, flatn_f, & - fresh, fhocn) - - use ice_domain_size, only: ncat - - integer (kind=int_kind), intent(in) :: & - nx_block, ny_block ! block dimensions - - logical (kind=log_kind), dimension (nx_block,ny_block), intent(in) :: & - tmask ! land/boundary mask, thickness (T-cell) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in):: & - aice ! initial ice concentration - - real (kind=dbl_kind), dimension(nx_block,ny_block,ncat), intent(in) :: & - fsurfn_f, & ! net surface heat flux (provided as forcing) - flatn_f ! latent heat flux (provided as forcing) - - real (kind=dbl_kind), dimension(nx_block,ny_block), intent(inout):: & - fresh , & ! fresh water flux to ocean (kg/m2/s) - fhocn ! actual ocn/ice heat flx (W/m**2) - - - ! local variables - integer (kind=int_kind) :: & - i, j, n ! horizontal indices - - real (kind=dbl_kind) :: & - puny, & ! - rLsub ! 1/Lsub - - character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - - 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__) - rLsub = c1 / Lsub - - do n = 1, ncat - do j = 1, ny_block - do i = 1, nx_block - if (tmask(i,j) .and. aice(i,j) <= puny) then - fhocn(i,j) = fhocn(i,j) & - + fsurfn_f(i,j,n) + flatn_f(i,j,n) - fresh(i,j) = fresh(i,j) & - + flatn_f(i,j,n) * rLsub - endif - enddo ! i - enddo ! j - enddo ! n - - - end subroutine sfcflux_to_ocn - -#endif - -!======================================================================= - - end module CICE_RunMod - -!======================================================================= diff --git a/cicecore/drivers/unittest/calchk/calchk.F90 b/cicecore/drivers/unittest/calchk/calchk.F90 new file mode 100644 index 000000000..bbd61b63e --- /dev/null +++ b/cicecore/drivers/unittest/calchk/calchk.F90 @@ -0,0 +1,588 @@ + + program calchk + + use ice_kinds_mod, only: int_kind, dbl_kind + use ice_calendar, only: myear, mmonth, mday, msec + use ice_calendar, only: year_init, month_init, day_init, sec_init + use ice_calendar, only: dt, ndtd, istep0, diagfreq, npt, npt_unit + use ice_calendar, only: months_per_year, daymo, timesecs, seconds_per_day + use ice_calendar, only: use_leap_years, days_per_year + use ice_calendar, only: compute_elapsed_days + use ice_calendar, only: update_date, calc_timesteps + 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 + 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) :: dyear,dmon,dday,dsec + integer(kind=int_kind) :: fyear,fmon,fday,fsec + character(len=32) :: calstr,unitstr,signstr + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + 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 + 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 + integer(kind=int_kind) :: yearc(ntests),monc(ntests),dayc(ntests),secc(ntests),ndayc(ntests) ! correct results + real(kind=dbl_kind) :: timesecsv(ntests),timesecsc(ntests) + character(len=*), parameter :: & + passflag = 'PASS', & + failflag = 'FAIL' + + write(6,*) ' ' + write(6,*) 'Running CALCHK' + write(6,*) ' ' + + errorflag0 = passflag + errorflag(:) = passflag + testname(:) = '' + testname(1) = 'compute_elapsed_days' + testname(2) = 'set_date_from_timesecs' + testname(3) = 'calendar advance' + testname(4) = 'date2time time2date' + testname(5) = 'big add/sub update_date' + testname(6) = 'small add/sub update_date' + testname(7) = 'special checks' + testname(8) = 'calc_timesteps' + + ndtd = 1 + + ! test yearmax years from year 0 +! yearmax = 1000 + yearmax = 100000 + + ! test 3 calendars + do n = 1,3 + + errorflag(:) = passflag + + if (n == 1) then + use_leap_years = .false. + days_per_year = 365 + calstr = 'noleap' + elseif (n == 2) then + use_leap_years = .false. + days_per_year = 360 + calstr = '360day' + elseif (n == 3) then + use_leap_years = .true. + days_per_year = 365 + calstr = 'gregorian' + endif + + istep0 = 1000 + year_init = 0 + month_init = 1 + day_init = 1 + sec_init = 0 + myear = -1 + mmonth = -1 + mday = -1 + dt = 86400._dbl_kind + diagfreq = 99999999 + call init_calendar() + + !----------------- + ! This test makes sure compute_elapsed_days works for different calendars + ! and multiple years. This also checks that the timesecs value computed + ! in calendar and passed into set_date_from_timesecs returns the correct date. + ! In test1, nday should increment 1 day each loop and the final number + ! of days is known for 1000 and 100000 years (precomputed) + ! In test2, set_date_from_timesecs will reset myear, mmonth, mday, msec + !----------------- + + ndayc(1) = -1 ! prior day + do ny = 0,yearmax + do nm = 1,months_per_year + do nd = 1,daymo(nm) + + errorflagtmp = passflag + yearv(1) = ny + monv(1) = nm + dayv(1) = nd + secv(1) = 0 + + ! check days increment by 1 + ndayv(1) = compute_elapsed_days(yearv(1),monv(1),dayv(1)) + if (ndayv(1) - ndayc(1) /= 1) then + errorflagtmp = failflag + errorflag(1) = failflag + write(6,*) 'ERROR1: did not increment one day',yearv(1),monv(1),dayv(1),ndayv(1) + endif + + ! establish internal date and update internal calendar including timesecs + myear = yearv(1) + mmonth = monv(1) + mday = dayv(1) + msec = secv(1) + call calendar() + timesecsv(1) = timesecs + + ! check set_date_from_timesecs + yearc(2) = myear + monc(2) = mmonth + dayc(2) = mday + secc(2) = msec + timesecsc(2) = timesecs + ndayc(2) = ndayv(1) + myear = -1 + mmonth = -1 + mday = -1 + msec = -1 + timesecs = -1 + call set_date_from_timesecs(timesecsc(2)) + if (myear /= yearc(2) .or. mmonth /= monc(2) .or. mday /= dayc(2) .or. msec /= secc(2) .or. timesecs /= timesecsc(2)) then + errorflagtmp = failflag + errorflag(2) = failflag + write(6,*) 'ERROR2: timesecs error' + write(6,1001) 'e2',ndayc(2),yearc(2),'-',monc(2),'-',dayc(2),':',secc(2),' timesecs = ',timesecsc(2) + endif + if (errorflagtmp /= passflag .or. & + ndayv(1) <= 10 .or. mod(ndayv(1),yearmax*10) == 0 .or. & + (yearv(1) == yearmax .and. monv(1) == months_per_year)) then + write(6,1001) ' CHECK1: ',ndayv(1),yearv(1) ,'-',monv(1),'-',dayv(1),':',secv(1) ,' timesecs = ',timesecsv(1) + endif + ndayc(1) = ndayv(1) + enddo + enddo + enddo + + ! check total number of days run in yearmax years + if (yearmax == 1000) then + if (n == 1) then + ndayc(1) = 365364 + elseif (n == 2) then + ndayc(1) = 360359 + elseif (n == 3) then + ndayc(1) = 365607 + endif + if (ndayv(1) /= ndayc(1)) then + errorflag(1) = failflag + write(6,*) 'ERROR1a: final nday incorrect', ndayv(1), ndayc(1) + endif + endif + + ! check total number of days run in yearmax years + if (yearmax == 100000) then + if (n == 1) then + ndayc(1) = 36500364 + elseif (n == 2) then + ndayc(1) = 36000359 + elseif (n == 3) then + ndayc(1) = 36524615 + endif + if (ndayv(1) /= ndayc(1)) then + errorflag(1) = failflag + write(6,*) 'ERROR1a: final nday incorrect', ndayv(1), ndayc(1) + endif + endif + + !----------------- + ! check adding arbitrary amounts to each date unit and see if calendar reconciles properly + ! then subtract same arbitrary amounts in reverse order and make sure it ends at original value + !----------------- + + yearv(1) = 1000 + monv(1) = 1 + dayv(1) = 1 + secv(1) = 0 + myear = yearv(1) + mmonth = monv(1) + mday = dayv(1) + msec = secv(1) + call calendar() + nday = compute_elapsed_days(myear,mmonth,mday) + dyear = 0 + dmon = 0 + dday = 0 + dsec = 0 + do nfa = 1,-1,-2 + write(6,*) ' ' + write(6,1001) ' CHECK3: ',nday,myear ,'-',mmonth ,'-',mday ,':',msec ,' timesecs = ',timesecs + do nfb = 1,10 + do nfc = 1,4 + if (nfa == 1) then + nf1 = nfb + nf2 = nfc + signstr = 'Add' + elseif (nfa == -1) then + nf1 = 11-nfb + nf2 = 5-nfc + signstr = 'Sub' + endif + fyear = 0 + fmon = 0 + fday = 0 + fsec = 0 + if (nf2 == 1) then + xadd = nf1*nf1 + unitstr = 'years' + myear = myear + nfa*xadd + if (nfa == 1) dyear = dyear + nfa*xadd + fyear = nfa*xadd + elseif (nf2 == 2) then + xadd = nf1*nf1 + unitstr = 'months' + mmonth = mmonth + nfa*xadd + if (nfa == 1) dmon = dmon + nfa*xadd + fmon = nfa*xadd + elseif (nf2 == 3) then + xadd = nf1*nf1*nf1*nf1 + unitstr = 'days' + mday = mday + nfa*xadd + if (nfa == 1) dday = dday + nfa*xadd + fday = nfa*xadd + elseif (nf2 == 4) then + xadd = nf1*nf1*nf1*nf1*nf1*nf1*nf1 + unitstr = 'seconds' + msec = msec + nfa*xadd + if (nfa == 1) dsec = dsec + nfa*xadd + fsec = nfa*xadd + endif + call calendar() + nday = compute_elapsed_days(myear,mmonth,mday) + write(6,1002) ' CHECK3: '//trim(signstr)//' ',xadd,trim(unitstr) + write(6,1001) ' CHECK3: ',nday,myear ,'-',mmonth ,'-',mday ,':',msec ,' timesecs = ',timesecs + + !----------------- + ! This checks update_date add and subtract to make sure the original value is returned + !----------------- + + yearc(6) = myear + monc(6) = mmonth + dayc(6) = mday + secc(6) = msec + timesecsc(6) = timesecs + yearv(6) = yearc(6) + monv(6) = monc(6) + dayv(6) = dayc(6) + secv(6) = secc(6) + call update_date(yearv(6),monv(6),dayv(6),secv(6),fyear,fmon,fday,fsec) + write(6,1001) ' CHECK6: ',-1,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6) + if (yearc(6) == yearv(6) .and. monc(6) == monv(6) .and. dayc(6) == dayv(6) .and. secc(6) == secv(6) .and. timesecsc(6) == timesecsv(6)) then + errorflag(6) = failflag + write(6,*) ' ' + write(6,*) 'ERROR6a: update date error' + write(6,1001) 'e6',nday,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6),' timesecs = ',timesecsv(6) + write(6,1001) ' ',nday,yearc(6),'-',monc(6),'-',dayc(6),':',secc(6),' timesecs = ',timesecsc(6) + write(6,*) ' ',fyear,fmon,fday,fsec + write(6,*) ' ' + endif + call update_date(yearv(6),monv(6),dayv(6),secv(6),-fyear,-fmon,-fday,-fsec) + call calendar_date2time(yearc(6),monc(6),dayc(6),secc(6),timesecsv(6)) + if (yearc(6) /= yearv(6) .or. monc(6) /= monv(6) .or. dayc(6) /= dayv(6) .or. secc(6) /= secv(6) .or. timesecsc(6) /= timesecsv(6)) then + errorflag(6) = failflag + write(6,*) ' ' + write(6,*) 'ERROR6b: update date error' + write(6,1001) 'e6',nday,yearv(6),'-',monv(6),'-',dayv(6),':',secv(6),' timesecs = ',timesecsv(6) + write(6,1001) ' ',nday,yearc(6),'-',monc(6),'-',dayc(6),':',secc(6),' timesecs = ',timesecsc(6) + write(6,*) ' ',fyear,fmon,fday,fsec + write(6,*) ' ' + endif + + !----------------- + ! This checks date2time and time2date leveraging the pseudo random dates + ! plus various reference settings. Different reference dates means + ! timesecs won't match, so don't check them. + !----------------- + + yi = myear/2 + mi = max(mmonth/2,1) + di = max(mday*7/8,1) + si = max(msec*7/8,1) + yearc(4) = myear + monc(4) = mmonth + dayc(4) = mday + secc(4) = msec + timesecsc(4) = timesecs + yearv(4) = -1 + monv(4) = -1 + dayv(4) = -1 + secv(4) = -1 + timesecsv(4) = -1 + call calendar_date2time(yearc(4),monc(4),dayc(4),secc(4),timesecsv(4),yi,mi,di,si) + call calendar_time2date(timesecsv(4),yearv(4),monv(4),dayv(4),secv(4),yi,mi,di,si) + write(6,*) 'CHECK4: ',timesecsv(4) + if (yearc(4) /= yearv(4) .or. monc(4) /= monv(4) .or. dayc(4) /= dayv(4) .or. secc(4) /= secv(4)) then + errorflag(4) = failflag + write(6,*) ' ' + write(6,*) 'ERROR4: date2time time2date error' + write(6,1001) 'e4',nday,yearv(4),'-',monv(4),'-',dayv(4),':',secv(4),' timesecs = ',timesecsv(4) + write(6,1001) ' ',nday,yearc(4),'-',monc(4),'-',dayc(4),':',secc(4),' timesecs = ',timesecsc(4) + write(6,*) ' ' + endif + + enddo + enddo + + yearv(3) = myear + monv(3) = mmonth + dayv(3) = mday + secv(3) = msec + timesecsv(3) = timesecs + if (nfa == 1) then + if (n == 1) then + yearc(3) = 1487 + monc(3) = 1 + dayc(3) = 21 + secc(3) = 22825 + ndayc(3) = 542775 + elseif (n == 2) then + yearc(3) = 1488 + monc(3) = 1 + dayc(3) = 13 + secc(3) = 22825 + ndayc(3) = 535692 + elseif (n == 3) then + yearc(3) = 1487 + monc(3) = 1 + dayc(3) = 5 + secc(3) = 22825 + ndayc(3) = 543120 + endif + elseif (nfa == -1) then + yearc(3) = yearv(1) + monc(3) = monv(1) + dayc(3) = dayv(1) + secc(3) = secv(1) + if (n == 1) then + ndayc(3) = 365000 + elseif (n == 2) then + ndayc(3) = 360000 + elseif (n == 3) then + ndayc(3) = 365243 + endif + endif + + ! check answers + if (yearv(3) /= yearc(3) .or. monv(3) /= monc(3) .or. dayv(3) /= dayc(3) .or. secv(3) /= secc(3)) then + errorflag(3) = failflag + write(6,*) ' ' + write(6,*) 'ERROR3: calendar advance error' + write(6,1001) 'e3',nday,yearc(3),'-',monc(3),'-',dayc(3),':',secc(3),' timesecs = ',timesecsc(3) + write(6,1001) ' ',nday,yearv(3),'-',monv(3),'-',dayv(3),':',secv(3),' timesecs = ',timesecsv(3) + write(6,*) ' ' + endif + enddo + + write(6,*) ' ' + yearv(1) = 1000 + monv(1) = 1 + dayv(1) = 1 + secv(1) = 0 + yearv(5) = yearv(1) + monv(5) = monv(1) + dayv(5) = dayv(1) + secv(5) = secv(1) + write(6,1001) ' CHECK5a: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,1002) ' Add ',dyear,'years' + write(6,1002) ' Add ',dmon,'months' + write(6,1002) ' Add ',dday,'days' + write(6,1002) ' Add ',dsec,'seconds' + call update_date(yearv(5),monv(5),dayv(5),secv(5),dyear,dmon,dday,dsec) + write(6,1001) ' CHECK5a: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,*) ' ' + + ! correct answers + if (n == 1) then + yearc(5) = 1487 + monc(5) = 1 + dayc(5) = 24 + secc(5) = 22825 + ndayc(5) = 542775 + elseif (n == 2) then + yearc(5) = 1488 + monc(5) = 1 + dayc(5) = 13 + secc(5) = 22825 + ndayc(5) = 535692 + elseif (n == 3) then + yearc(5) = 1487 + monc(5) = 1 + dayc(5) = 7 + secc(5) = 22825 + ndayc(5) = 543120 + endif + + ! check answers + if (yearv(5) /= yearc(5) .or. monv(5) /= monc(5) .or. dayv(5) /= dayc(5) .or. secv(5) /= secc(5)) then + errorflag(5) = failflag + write(6,*) ' ' + write(6,*) 'ERROR5a: calendar advance error' + write(6,1001) 'e5',nday,yearc(5),'-',monc(5),'-',dayc(5),':',secc(5),' timesecs = ',timesecs + write(6,1001) ' ',nday,yearv(5),'-',monv(5),'-',dayv(5),':',secv(5),' timesecs = ',timesecs + write(6,*) ' ' + endif + + write(6,1001) ' CHECK5b: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + write(6,1002) ' Sub ',dyear,'years' + write(6,1002) ' Sub ',dmon,'months' + write(6,1002) ' Sub ',dday,'days' + write(6,1002) ' Sub ',dsec,'seconds' + call update_date(yearv(5),monv(5),dayv(5),secv(5),-dyear,-dmon,-dday,-dsec) + write(6,1001) ' CHECK5b: ',-1,yearv(5) ,'-',monv(5) ,'-',dayv(5) ,':',secv(5) + + ! correct answers + yearc(5) = yearv(1) + monc(5) = monv(1) + dayc(5) = dayv(1) + secc(5) = secv(1) + if (yearv(5) /= yearc(5) .or. monv(5) /= monc(5) .or. dayv(5) /= dayc(5) .or. secv(5) /= secc(5)) then + errorflag(5) = failflag + write(6,*) ' ' + write(6,*) 'ERROR5b: calendar advance error' + write(6,1001) 'e5',nday,yearc(5),'-',monc(5),'-',dayc(5),':',secc(5),' timesecs = ',timesecs + write(6,1001) ' ',nday,yearv(5),'-',monv(5),'-',dayv(5),':',secv(5),' timesecs = ',timesecs + write(6,*) ' ' + endif + + !------------------------- + ! Special checks: + ! Add a month to the last day of each month + ! Check date2time for seconds + !------------------------- + + write(6,*) ' ' + do ny = 1,5 + do nm = 1, months_per_year + if (ny == 1) yearv(7) = 1900 + if (ny == 2) yearv(7) = 1999 + if (ny == 3) yearv(7) = 2000 + if (ny == 4) yearv(7) = 2004 + if (ny == 5) yearv(7) = 2005 + call compute_calendar_data(yearv(7),tdaymo,tdaycal,tdayyr) + monv(7) = nm + dayv(7) = tdaymo(nm) + secv(7) = 0 + if (tdaymo(mod(nm,months_per_year)+1) >= tdaymo(nm)) then + monc(7) = mod(nm,months_per_year)+1 + dayc(7) = dayv(7) + else + monc(7) = mod(nm+1,months_per_year)+1 + dayc(7) = tdaymo(nm) - tdaymo(mod(nm,months_per_year)+1) + endif + yearc(7) = yearv(7) + if (monc(7) < monv(7)) yearc(7) = yearv(7) + 1 + secc(7) = secv(7) + call update_date(yearv(7),monv(7),dayv(7),secv(7),dmon=1) + write(6,1001) ' CHECK7a:',1,yearv(7),'-',monv(7),'-',dayv(7),':',secv(7) + if (yearv(7) /= yearc(7) .or. monv(7) /= monc(7) .or. dayv(7) /= dayc(7) .or. secv(7) /= secc(7)) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7a: add 1 month to end of month error' + write(6,1001) 'e7',-1,yearc(7),'-',monc(7),'-',dayc(7),':',secc(7) + write(6,1001) ' ',-1,yearv(7),'-',monv(7),'-',dayv(7),':',secv(7) + write(6,*) ' ' + endif + enddo + enddo + + do ns1 = 0,seconds_per_day,seconds_per_day/4 + do ns2 = 0,seconds_per_day,seconds_per_day/4 + yearv(7) = 2002 + monv(7) = 3 + call compute_calendar_data(yearv(7),tdaymo,tdaycal,tdayyr) + dayv(7) = tdaymo(monv(7)) + call calendar_date2time(yearv(7),monv(7),dayv(7),ns2,timesecsv(7),yearv(7),monv(7),dayv(7),ns1) + write(6,*) 'CHECK7b:',ns1,ns2,timesecsv(7) + if (timesecsv(7) /= ns2-ns1) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7b: sec diff same date error' + write(6,*) ' ',ns1,ns2,timesecsv(7),ns2-ns1 + write(6,*) ' ' + endif + call calendar_date2time(yearv(7),monv(7)+1,1,ns2,timesecsv(7),yearv(7),monv(7),dayv(7),ns1) + write(6,*) 'CHECK7c:',ns1,ns2,timesecsv(7) + if (timesecsv(7) /= ns2-ns1+seconds_per_day) then + errorflag(7) = failflag + write(6,*) ' ' + write(6,*) 'ERROR7c: sec diff next day error' + write(6,*) ' ',ns1,ns2,timesecsv(7),ns2-ns1+seconds_per_day + write(6,*) ' ' + endif + enddo + enddo + + !------------------------- + ! calc_timesteps + !------------------------- + + myear = 2000 + mmonth = 2 + mday = 1 + msec = 0 + do nf1 = 1,6 + npt = 10 + dt = 3600._dbl_kind + + if (nf1 == 1) then + npt_unit = '1' + nptc = 10 + endif + if (nf1 == 2) then + npt_unit = 's' + npt = 36000. + nptc = 10 + endif + if (nf1 == 3) then + npt_unit = 'h' + nptc = 10 + endif + if (nf1 == 4) then + npt_unit = 'd' + nptc = 240 + endif + if (nf1 == 5) then + npt_unit = 'm' + if (n == 1) nptc = 7272 + if (n == 2) nptc = 7200 + if (n == 3) nptc = 7296 + endif + if (nf1 == 6) then + npt_unit = 'y' + if (n == 1) nptc = 87600 + if (n == 2) nptc = 86400 + if (n == 3) nptc = 87672 + endif + call calc_timesteps() + write(6,*) 'CHECK8:',npt + if (npt /= nptc) then + errorflag(8) = failflag + write(6,*) 'ERROR8: npt error',npt,nptc + endif + enddo + + !------------------------- + ! write test results + !------------------------- + + write(6,*) ' ' + write(6,*) 'Test Results: ',yearmax,' years' + do m = 1,ntests + write(6,*) trim(errorflag(m))," ... ",trim(calstr)," ",trim(testname(m)) + if (errorflag(m) == failflag) errorflag0=failflag + enddo + write(6,*) ' ' + + enddo ! do n + + 1001 format(a,i10,1x,i7.4,a,i2.2,a,i2.2,a,i5.5,a,e23.16) + 1002 format(a,i10,1x,a) + + write(6,*) ' ' + if (errorflag0 == passflag) then + write(6,*) 'CALCHK COMPLETED SUCCESSFULLY' + else + write(6,*) 'CALCHK FAILED' + endif + + end program + diff --git a/cicecore/drivers/unittest/helloworld/helloworld.F90 b/cicecore/drivers/unittest/helloworld/helloworld.F90 new file mode 100644 index 000000000..651436bea --- /dev/null +++ b/cicecore/drivers/unittest/helloworld/helloworld.F90 @@ -0,0 +1,8 @@ + + program hello_world + + write(6,*) 'hello_world' + write(6,*) 'COMPLETED SUCCESSFULLY' + + end program + diff --git a/cicecore/shared/ice_calendar.F90 b/cicecore/shared/ice_calendar.F90 index e7107f42a..4d7ae378f 100644 --- a/cicecore/shared/ice_calendar.F90 +++ b/cicecore/shared/ice_calendar.F90 @@ -2,7 +2,7 @@ ! Calendar routines for managing time ! -! authors: Elizabeth C. Hunke, LANL +! Authors: Elizabeth C. Hunke, LANL ! Tony Craig, NCAR ! Craig MacLachlan, UK Met Office ! @@ -10,10 +10,12 @@ ! Converted to free form source (F90). ! 2010 CM : Fixed support for Gregorian calendar: subroutines ! sec2time, time2sec and set_calendar added. +! 2020 TC : Significant refactor to move away from time as prognostic module ice_calendar use ice_kinds_mod + use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, c100, c30, c360, c365, c3600, & c4, c400 use ice_domain_size, only: max_nstrm @@ -25,78 +27,88 @@ module ice_calendar implicit none private - public :: init_calendar, calendar, time2sec, sec2time, hc_jday + ! INTERFACES - integer (kind=int_kind), public :: & - days_per_year , & ! number of days in one year - daymo(12) , & ! number of days in each month - daycal(13) ! day number at end of month + public :: init_calendar ! initialize calendar + public :: calc_timesteps ! initialize number of timesteps (after namelist and restart are read) + public :: advance_timestep ! advance model 1 timestep and update calendar + public :: calendar ! update model internal calendar/time information + public :: set_date_from_timesecs ! set model date from time in seconds + ! (relative to init date) + ! needed for binary restarts - ! 360-day year data - integer (kind=int_kind) :: & - daymo360(12) , & ! number of days in each month - daycal360(13) ! day number at end of month - data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/ - data daycal360/ 0,30, 60, 90,120,150,180,210,240,270,300,330,360/ + ! semi-private, only used directly by unit tester + public :: compute_elapsed_days ! compute elapsed days since 0000-01-01 + public :: compute_days_between ! compute elapsed days between two dates + 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 :: compute_calendar_data ! compute info about calendar for a given year - ! 365-day year data - integer (kind=int_kind) :: & - daymo365(12) , & ! number of days in each month - daycal365(13) ! day number at end of month - data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ - data daycal365/ 0,31, 59, 90,120,151,181,212,243,273,304,334,365/ + ! private functions + private :: set_calendar ! sets model calendar type (noleap, etc) - ! 366-day year data (leap year) - integer (kind=int_kind) :: & - daymo366(12) , & ! number of days in each month - daycal366(13) ! day number at end of month - data daymo366 / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ - data daycal366/ 0,31, 60, 91,121,152,182,213,244,274,305,335,366/ + ! PUBLIC - real (kind=dbl_kind), parameter :: & - days_per_4c = 146097.0_dbl_kind, & - days_per_c = 36524.0_dbl_kind, & - days_per_4y = 1461.0_dbl_kind, & - days_per_y = 365.0_dbl_kind + character(len=*), public, parameter :: & + ice_calendar_gregorian = 'Gregorian', & ! calendar name, actually proleptic gregorian here + ice_calendar_noleap = 'NO_LEAP', & ! 365 day per year 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 + + integer (kind=int_kind), public :: & + seconds_per_day , & ! seconds per day + seconds_per_hour , & ! seconds per hour + days_per_year , & ! number of days in one year + daymo(months_per_year), & ! number of days in each month + daycal(months_per_year+1) ! accumulated days in year to end of prior month integer (kind=int_kind), public :: & - istep , & ! local step counter for time loop - istep0 , & ! counter, number of steps taken in previous run + ! step counters + istep , & ! local step counter for current run in time loop + istep0 , & ! counter, number of steps at start of run istep1 , & ! counter, number of steps at current timestep + ! basic model time variables + myear , & ! year number + mmonth , & ! month number, 1 to months_per_year mday , & ! day of the month - hour , & ! hour of the day - month , & ! month number, 1 to 12 - monthp , & ! last month + msec , & ! elapsed seconds into date + ! initial time year_init, & ! initial year - nyr , & ! year number + month_init,& ! initial month + day_init, & ! initial day of month + sec_init , & ! initial seconds + ! other stuff idate , & ! date (yyyymmdd) - idate0 , & ! initial date (yyyymmdd) - sec , & ! elapsed seconds into date + idate0 , & ! initial date (yyyymmdd), associated with year_init, month_init, day_init + dayyr , & ! number of days in the current year npt , & ! total number of time steps (dt) + npt0 , & ! original npt value in npt0_unit ndtd , & ! number of dynamics subcycles: dt_dyn=dt/ndtd stop_now , & ! if 1, end program execution write_restart, & ! if 1, write restart now diagfreq , & ! diagnostic output frequency (10 = once per 10 dt) dumpfreq_n , & ! restart output frequency (10 = once per 10 d,m,y) nstreams , & ! number of history output streams - histfreq_n(max_nstrm) ! history output frequency + histfreq_n(max_nstrm) ! history output frequency + + logical (kind=log_kind), public :: & + new_year , & ! new year = .true. + new_month , & ! new month = .true. + new_day , & ! new day = .true. + new_hour ! new hour = .true. real (kind=dbl_kind), public :: & dt , & ! thermodynamics timestep (s) dt_dyn , & ! dynamics/transport/ridging timestep (s) - time , & ! total elapsed time (s) - time_forc , & ! time of last forcing update (s) + timesecs , & ! total elapsed time (s) yday , & ! day of the year - tday , & ! absolute day number - dayyr , & ! number of days per year - nextsw_cday , & ! julian day of next shortwave calculation - basis_seconds ! Seconds since calendar zero + nextsw_cday ! julian day of next shortwave calculation logical (kind=log_kind), public :: & - new_year , & ! new year = .true. - new_month , & ! new month = .true. - new_day , & ! new day = .true. - new_hour , & ! new hour = .true. use_leap_years , & ! use leap year functionality if true write_ic , & ! write initial condition now dump_last , & ! write restart file on last time step @@ -104,6 +116,8 @@ module ice_calendar write_history(max_nstrm) ! write history now character (len=1), public :: & + npt_unit, & ! run length unit, 'y', 'm', 'd', 'h', 's', '1' + npt0_unit, & ! original run length unit, 'y', 'm', 'd', 'h', 's', '1' histfreq(max_nstrm), & ! history output frequency, 'y','m','d','h','1' dumpfreq ! restart frequency, 'y','m','d' @@ -111,17 +125,33 @@ module ice_calendar calendar_type ! differentiates Gregorian from other calendars ! default = ' ' + ! PRIVATE + + integer (kind=int_kind) :: & + hour ! hour of the day + + ! 360-day year data + integer (kind=int_kind) :: & + daymo360(months_per_year) ! number of days in each month + data daymo360 / 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30/ + + ! 365-day year data + integer (kind=int_kind) :: & + daymo365(months_per_year) ! number of days in each month + data daymo365 / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ + + ! 366-day year data (leap year) + integer (kind=int_kind) :: & + daymo366(months_per_year) ! number of days in each month + data daymo366 / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ + + !======================================================================= contains !======================================================================= - ! Initialize calendar variables -! -! authors: Elizabeth C. Hunke, LANL -! Tony Craig, NCAR -! Craig MacLachlan, UK Met Office subroutine init_calendar @@ -134,99 +164,178 @@ subroutine init_calendar if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + seconds_per_day = nint(secday) + if ((abs(real(seconds_per_day,kind=dbl_kind)/secday)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR secday should basically be an integer',secday + call abort_ice(subname//'ERROR: improper secday') + endif + seconds_per_hour = nint(secday/real(hours_per_day,kind=dbl_kind)) + if (abs(seconds_per_hour*hours_per_day - seconds_per_day) > 0) then + write(nu_diag,*) trim(subname),' ERROR seconds per day and hours per day inconsistent' + call abort_ice(subname//'ERROR: improper seconds_per_hour') + endif + istep = 0 ! local timestep number - time=istep0*dt ! s - yday=c0 ! absolute day number - mday=0 ! day of the month - month=0 ! month - nyr=0 ! year - idate=00000101 ! date - sec=0 ! seconds into date + myear=year_init ! year + mmonth=month_init ! month + mday=day_init ! day of the month + msec=sec_init ! seconds into date + 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) + idate0 = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd) stop_now = 0 ! end program execution if stop_now=1 dt_dyn = dt/real(ndtd,kind=dbl_kind) ! dynamics et al timestep force_restart_now = .false. - ! Check that the number of days per year is set correctly when using - ! leap years. If not, set days_per_year correctly and warn the user. - if (use_leap_years .and. days_per_year /= 365) then - days_per_year = 365 - write(nu_diag,*) 'Warning: days_per_year has been set to 365', & - ' because use_leap_years = .true.' - end if - #ifdef CESMCOUPLED ! calendar_type set by coupling #else - calendar_type = ' ' - if (use_leap_years .and. days_per_year == 365) calendar_type = 'Gregorian' -#endif - - dayyr = real(days_per_year, kind=dbl_kind) - if (days_per_year == 360) then - daymo = daymo360 - daycal = daycal360 - elseif (days_per_year == 365) then - daymo = daymo365 - daycal = daycal365 - else - call abort_ice(subname//'ERROR: days_per_year must be 360 or 365') + calendar_type = '' + if (use_leap_years) then + if (days_per_year == 365) then + calendar_type = trim(ice_calendar_gregorian) + else + call abort_ice(subname//'ERROR: use_leap_years is true, must set days_per_year to 365') + endif + else + if (days_per_year == 365) then + calendar_type = trim(ice_calendar_noleap) + elseif (days_per_year == 360) then + calendar_type = trim(ice_calendar_360day) + else + call abort_ice(subname//'ERROR: days_per_year only 365 or 360 supported') + endif endif +#endif - ! Get the time in seconds from calendar zero to start of initial year - call time2sec(year_init,1,1,basis_seconds) + call set_calendar(myear) + call calendar() - ! determine initial date (assumes namelist year_init, istep0 unchanged) - sec = mod(time,secday) ! elapsed seconds into date at - ! end of dt - tday = (time-sec)/secday + c1 ! absolute day number + end subroutine init_calendar - ! Convert the current timestep into a calendar date - call sec2time(nyr,month,mday,basis_seconds+sec) +!======================================================================= +! Initialize timestep counter +! This converts npt_unit and npt to a number of timesteps stored in npt +! npt0 and npt0_unit remember the original values +! It is safe to call this more than once, but it should be called only after +! the initial model run date is known (from namelist or restart) and before +! the first timestep - yday = mday + daycal(month) ! day of the year - nyr = nyr - year_init + 1 ! year number + subroutine calc_timesteps - idate0 = (nyr+year_init-1)*10000 + month*100 + mday ! date (yyyymmdd) + real (kind=dbl_kind) :: secday ! seconds per day + real (kind=dbl_kind) :: dtimesecs ! time in seconds of run + integer (kind=int_kind) :: yeare,monthe,daye,sece ! time at end of run + character(len=*),parameter :: subname='(calc_timesteps)' - end subroutine init_calendar + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) -!======================================================================= + yeare = myear + monthe = mmonth + daye = mday + sece = msec + npt0 = npt + npt0_unit = npt_unit + + if (npt_unit == 'y') then + call update_date(yeare,monthe,daye,sece,dyear=npt) + call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec) + elseif (npt_unit == 'm') then + call update_date(yeare,monthe,daye,sece,dmon=npt) + call calendar_date2time(yeare,monthe,daye,sece,dtimesecs,myear,mmonth,mday,msec) + elseif (npt_unit == 'd') then + dtimesecs = real(npt,kind=dbl_kind)*secday + call update_date(yeare,monthe,daye,sece,dday=npt) + elseif (npt_unit == 'h') then + dtimesecs = real(npt,kind=dbl_kind)*secday/real(hours_per_day,kind=dbl_kind) + call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs)) + elseif (npt_unit == 's') then + call update_date(yeare,monthe,daye,sece,dsec=npt) + dtimesecs = real(npt,kind=dbl_kind) + elseif (npt_unit == '1') then + dtimesecs = dt*real(npt,kind=dbl_kind) + call update_date(yeare,monthe,daye,sece,dsec=nint(dtimesecs)) + else + write(nu_diag,*) trim(subname),' ERROR invalid npt_unit = ',trim(npt_unit) + call abort_ice(subname//'ERROR: invalid npt_unit') + endif + + npt = nint(dtimesecs/dt) + npt_unit = '1' + + if (my_task == master_task) then + write(nu_diag,*) ' ' + write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,' modified npt from ',npt0,' '//trim(npt0_unit)//' with dt= ',dt + write(nu_diag,'(1x,2a,i9,a,f13.2)') subname,' to ',npt ,' '//trim(npt_unit )//' with dt= ',dt + write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,' start time is',myear,'-',mmonth,'-',mday,':',msec + write(nu_diag,'(1x,2a,i6.4,a,i2.2,a,i2.2,a,i5.5)') subname,' end time is',yeare,'-',monthe,'-',daye,':',sece + write(nu_diag,*) ' ' + endif + + ! check that npt is very close to an integer + if ((abs(real(npt,kind=dbl_kind)*dt/dtimesecs)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR dt and npt not consistent',npt,dt + call abort_ice(subname//'ERROR: improper npt') + endif + + end subroutine calc_timesteps +!======================================================================= ! Determine the date at the end of the time step -! -! authors: Elizabeth C. Hunke, LANL -! Tony Craig, NCAR -! Craig MacLachlan, UK Met Office - subroutine calendar(ttime) + subroutine advance_timestep() - use ice_communicate, only: my_task, master_task + ! local variables + + integer(kind=int_kind) :: & + idt ! integer dt + character(len=*),parameter :: subname='(advance_timestep)' + + if (trim(npt_unit) /= '1') then + write(nu_diag,*) trim(subname),' ERROR npt_unit should be converted to timesteps by now ',trim(npt_unit) + write(nu_diag,*) trim(subname),' ERROR you may need to call calc_timesteps to convert from other units' + call abort_ice(subname//'ERROR: npt_unit incorrect') + endif + + istep = istep + 1 + istep1 = istep1 + 1 + idt = nint(dt) + ! dt is historically a real but it should be an integer + ! make sure dt is very close to an integer + if ((abs(real(idt,kind=dbl_kind)/dt)-1.0_dbl_kind) > 1.0e-7) then + write(nu_diag,*) trim(subname),' ERROR dt error, needs to be integer number of seconds, dt=',dt + call abort_ice(subname//'ERROR: improper dt') + endif + msec = msec + idt + call calendar() - real (kind=dbl_kind), intent(in) :: & - ttime ! time variable + end subroutine advance_timestep + +!======================================================================= +! Update the calendar and time manager info + + subroutine calendar() + +! real (kind=dbl_kind), intent(in), optional :: & +! ttime ! time variable ! local variables integer (kind=int_kind) :: & ns , & ! loop index - nyrp,mdayp,hourp , & ! previous year, day, hour + yearp,monthp,dayp,hourp , & ! previous year, month, day, hour elapsed_days , & ! since beginning this run elapsed_months , & ! since beginning this run - elapsed_hours , & ! since beginning this run - month0 - real (kind=dbl_kind) :: secday ! seconds per day + elapsed_hours ! since beginning this run character(len=*),parameter :: subname='(calendar)' - call icepack_query_parameters(secday_out=secday) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) - - nyrp=nyr - monthp=month - mdayp=mday + yearp=myear + monthp=mmonth + dayp=mday hourp=hour new_year=.false. new_month=.false. @@ -235,349 +344,576 @@ subroutine calendar(ttime) write_history(:)=.false. write_restart=0 - sec = mod(ttime,secday) ! elapsed seconds into date at - ! end of dt - tday = (ttime-sec)/secday + c1 ! absolute day number - - ! Deterime the current date from the timestep - call sec2time(nyr,month,mday,basis_seconds+ttime) + call update_date(myear,mmonth,mday,msec) + call set_calendar(myear) - yday = mday + daycal(month) ! day of the year - nyr = nyr - year_init + 1 ! year number - - hour = int((ttime)/c3600) + c1 ! hour + idate = (myear)*10000 + mmonth*100 + mday ! date (yyyymmdd) + yday = daycal(mmonth) + mday ! day of the year + hour = (msec+1)/(seconds_per_hour) + elapsed_months = (myear - year_init)*months_per_year + mmonth - month_init + elapsed_days = compute_days_between(year_init,month_init,day_init,myear,mmonth,mday) + elapsed_hours = elapsed_days * hours_per_day + call calendar_date2time(myear,mmonth,mday,msec,timesecs) - month0 = int((idate0 - int(idate0 / 10000) * 10000) / 100) - - elapsed_months = (nyr - 1)*12 + (month - month0) - elapsed_days = int((istep * dt) / secday) - elapsed_hours = int(ttime/3600) - - idate = (nyr+year_init-1)*10000 + month*100 + mday ! date (yyyymmdd) + !--- compute other stuff #ifndef CESMCOUPLED if (istep >= npt+1) stop_now = 1 if (istep == npt .and. dump_last) write_restart = 1 ! last timestep #endif - if (nyr /= nyrp) new_year = .true. - if (month /= monthp) new_month = .true. - if (mday /= mdayp) new_day = .true. - if (hour /= hourp) new_hour = .true. + if (myear /= yearp) new_year = .true. + if (mmonth /= monthp) new_month = .true. + if (mday /= dayp) new_day = .true. + if (hour /= hourp) new_hour = .true. + ! History writing flags do ns = 1, nstreams - if (histfreq(ns)=='1' .and. histfreq_n(ns)/=0) then - if (mod(istep1, histfreq_n(ns))==0) & - write_history(ns)=.true. - endif + + select case (histfreq(ns)) + case ("y", "Y") + if (new_year .and. histfreq_n(ns)/=0) then + if (mod(myear, histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("m", "M") + if (new_month .and. histfreq_n(ns)/=0) then + if (mod(elapsed_months,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("d", "D") + if (new_day .and. histfreq_n(ns)/=0) then + if (mod(elapsed_days,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("h", "H") + if (new_hour .and. histfreq_n(ns)/=0) then + if (mod(elapsed_hours,histfreq_n(ns))==0) & + write_history(ns) = .true. + endif + case ("1") + if (histfreq_n(ns)/=0) then + if (mod(istep1, histfreq_n(ns))==0) & + write_history(ns)=.true. + endif + end select + enddo - if (dumpfreq == '1') then + ! Restart writing flag + + select case (dumpfreq) + case ("y", "Y") + if (new_year .and. mod(myear, dumpfreq_n)==0) & + write_restart = 1 + case ("m", "M") + if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) & + write_restart = 1 + case ("d", "D") + if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) & + write_restart = 1 + case ("h", "H") + if (new_hour .and. mod(elapsed_hours, dumpfreq_n)==0) & + write_restart = 1 + case ("1") if (mod(istep1, dumpfreq_n)==0) & write_restart = 1 - endif - - if (istep > 1) then + end select - do ns = 1, nstreams + if (force_restart_now) write_restart = 1 - select case (histfreq(ns)) - case ("y", "Y") - if (new_year .and. histfreq_n(ns)/=0) then - if (mod(nyr, histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("m", "M") - if (new_month .and. histfreq_n(ns)/=0) then - if (mod(elapsed_months,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("d", "D") - if (new_day .and. histfreq_n(ns)/=0) then - if (mod(elapsed_days,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - case ("h", "H") - if (new_hour .and. histfreq_n(ns)/=0) then - if (mod(elapsed_hours,histfreq_n(ns))==0) & - write_history(ns) = .true. - endif - end select - - enddo ! nstreams - - select case (dumpfreq) - case ("y", "Y") - if (new_year .and. mod(nyr, dumpfreq_n)==0) & - write_restart = 1 - case ("m", "M") - if (new_month .and. mod(elapsed_months,dumpfreq_n)==0) & - write_restart = 1 - case ("d", "D") - if (new_day .and. mod(elapsed_days, dumpfreq_n)==0) & - write_restart = 1 - case ("h", "H") - if (new_hour .and. mod(elapsed_hours, dumpfreq_n)==0) & - write_restart = 1 - end select - - if (force_restart_now) write_restart = 1 - - endif ! istep > 1 - - if (my_task == master_task .and. mod(istep,diagfreq) == 0 & + if (my_task == master_task .and. mod(istep1,diagfreq) == 0 & .and. stop_now /= 1) then write(nu_diag,*) ' ' write(nu_diag,'(a7,i10,4x,a6,i10,4x,a4,i10)') & - 'istep1:', istep1, 'idate:', idate, 'sec:', sec + 'istep1:', istep1, 'idate:', idate, 'sec:', msec endif end subroutine calendar !======================================================================= +! Set the model calendar data for year -! Convert the date to seconds since calendar zero. -! ** This is based on the UM routine TIME2SEC ** -! -! authors: Craig MacLachlan, UK Met Office + subroutine set_calendar(year) - subroutine time2sec(year,month,day,tsec) + integer (kind=int_kind), intent(in) :: year ! current year - integer (kind=int_kind), intent(in) :: year ! year - integer (kind=int_kind), intent(in) :: month ! month - integer (kind=int_kind), intent(in) :: day ! year - real (kind=dbl_kind), intent(out) :: tsec ! seconds since calendar zero + ! Internal variable + character(len=*),parameter :: subname='(set_calendar)' - ! local variables + call compute_calendar_data(year,daymo,daycal,dayyr) - real (kind=dbl_kind) :: days_since_calz ! days since calendar zero - real (kind=dbl_kind) :: secday ! seconds per day - integer (kind=int_kind) :: years_since_calz ! days since calendar zero - character(len=*),parameter :: subname='(time2sec)' + end subroutine set_calendar + +!======================================================================= +! Add and reconcile date +! delta time arguments are optional + + subroutine update_date(ayear,amon,aday,asec,dyear,dmon,dday,dsec) + + integer (kind=int_kind), intent(inout) :: ayear, amon, aday, asec ! year, month, day, sec + integer (kind=int_kind), intent(in), optional :: dyear, dmon, dday, dsec ! delta year, month, day, sec + + ! local variables + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + real (kind=dbl_kind) :: secday ! seconds per day + integer (kind=int_kind) :: isecday ! seconds per day + integer (kind=int_kind) :: delta + character(len=*),parameter :: subname='(update_date)' call icepack_query_parameters(secday_out=secday) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) + isecday = nint(secday) + + ! order matters. think about adding 1 month and 10 days to the 25th of a month + ! what is the right order? + ! will add all deltas then reconcile years then months then days then seconds + + if (present(dyear)) ayear = ayear + dyear + if (present(dmon)) amon = amon + dmon + if (present(dday)) aday = aday + dday + if (present(dsec)) asec = asec + dsec + + ! adjust negative data first + ! reconcile months - years + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + enddo + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + + ! reconcile days - months - years + do while (aday <= 0) + amon = amon - 1 + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + aday = aday + tdaymo(amon) + enddo - if (dayyr == 360) then - days_since_calz = c360*year + c30*(month-1) + day - c1 - tsec = secday * days_since_calz + ! reconcile seconds - days - months - years + if (asec < 0) then + delta = int(abs(asec)/isecday) + 1 + aday = aday - delta + asec = asec + delta*isecday + endif + do while (aday <= 0) + amon = amon - 1 + do while (amon <= 0) + delta = int((abs(amon))/months_per_year) + 1 + ayear = ayear - delta + amon = amon + delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + aday = aday + tdaymo(amon) + enddo - else - - if (use_leap_years) then + ! check for negative data + if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then + write(nu_diag,*) trim(subname),' ERROR in dateA, ',ayear,amon,aday,asec + call abort_ice(subname//'ERROR: in date') + endif + + ! reconcile months - years + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + enddo + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + + ! reconcile days - months - years + do while (aday > tdaymo(amon)) + aday = aday - tdaymo(amon) + amon = amon + 1 + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + enddo - call set_calendar(year) + ! reconcile seconds - days - months - years + if (asec >= isecday) then + delta = int(asec/isecday) + aday = aday + delta + asec = asec - delta*isecday + endif + do while (aday > tdaymo(amon)) + aday = aday - tdaymo(amon) + amon = amon + 1 + do while (amon > months_per_year) + delta = int((amon-1)/months_per_year) + ayear = ayear + delta + amon = amon - delta*months_per_year + call compute_calendar_data(ayear,tdaymo,tdaycal,tdayyr) + enddo + enddo - ! Add on the days from this year - days_since_calz = day + daycal(month) - c1 + ! check for negative data, just in case + if (ayear < 0 .or. amon <= 0 .or. aday <= 0 .or. asec < 0) then + write(nu_diag,*) trim(subname),' ERROR in dateB, ',ayear,amon,aday,asec + call abort_ice(subname//'ERROR: in date') + endif - ! Subtract a year because we only want to count whole years - years_since_calz = year - 1 - - ! Add days from preceeding years - days_since_calz = days_since_calz & - + int(years_since_calz/c400)*days_per_4c - years_since_calz = years_since_calz & - - int(years_since_calz/c400)*400 + end subroutine update_date - days_since_calz = days_since_calz & - + int(years_since_calz/c100)*days_per_c - years_since_calz = years_since_calz & - - int(years_since_calz/c100)*100 +!======================================================================= - days_since_calz = days_since_calz & - + int(years_since_calz/c4)*days_per_4y - years_since_calz = years_since_calz & - - int(years_since_calz/c4)*4 +! Set internal calendar date from timesecs input +! Needed for binary restarts where only timesecs is on the restart file - days_since_calz = days_since_calz & - + years_since_calz*days_per_y + subroutine set_date_from_timesecs(ttimesecs) - tsec = secday * days_since_calz - - else ! Using fixed 365-day calendar - - days_since_calz = c365*year + daycal365(month) + day - c1 - tsec = secday * days_since_calz + real (kind=dbl_kind), intent(in) :: ttimesecs ! seconds since init date - end if + ! Internal variable + character(len=*),parameter :: subname='(set_date_from_timesecs)' - end if + timesecs = ttimesecs + call calendar_time2date(ttimesecs,myear,mmonth,mday,msec,year_init,month_init,day_init,sec_init) - end subroutine time2sec + end subroutine set_date_from_timesecs !======================================================================= +! Compute elapsed days from year0,month0,day0 to year1,month1,day1 +! Same day results in 0 elapsed days -! Convert the time in seconds since calendar zero to a date. -! -! authors: Craig MacLachlan, UK Met Office + integer function compute_days_between(year0,month0,day0,year1,month1,day1) - subroutine sec2time(year,month,day,tsec) + integer (kind=int_kind), intent(in) :: year0 ! start year + integer (kind=int_kind), intent(in) :: month0 ! start month + integer (kind=int_kind), intent(in) :: day0 ! start day + integer (kind=int_kind), intent(in) :: year1 ! end year + integer (kind=int_kind), intent(in) :: month1 ! end month + integer (kind=int_kind), intent(in) :: day1 ! end day - integer (kind=int_kind), intent(out) :: year ! year - integer (kind=int_kind), intent(out) :: month ! month - integer (kind=int_kind), intent(out) :: day ! year - real (kind=dbl_kind), intent(in) :: tsec ! seconds since calendar zero + ! Internal variable + logical (kind=log_kind) :: isleap ! Leap year logical + integer (kind=int_kind) :: nday0, nday1 + character(len=*),parameter :: subname='(compute_days_between)' - ! local variables + nday0 = compute_elapsed_days(year0,month0,day0) + nday1 = compute_elapsed_days(year1,month1,day1) - real (kind=dbl_kind) :: days_since_calz ! days since calendar zero - real (kind=dbl_kind) :: secday ! seconds per day - integer (kind=int_kind) :: k ! counter - character(len=*),parameter :: subname='(sec2time)' + compute_days_between = nday1 - nday0 - call icepack_query_parameters(secday_out=secday) - call icepack_warnings_flush(nu_diag) - if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & - file=__FILE__, line=__LINE__) + end function compute_days_between + +!======================================================================= +! compute calendar data based on year + + subroutine compute_calendar_data(ayear,adaymo,adaycal,adayyr) + + integer (kind=int_kind), intent(in) :: ayear ! year + integer (kind=int_kind), intent(out) :: adaymo(:) ! days per month + integer (kind=int_kind), intent(out) :: adaycal(:) ! day count per month + integer (kind=int_kind), intent(out) :: adayyr ! days per year + + ! Internal variable + logical (kind=log_kind) :: isleap ! Leap year logical + integer (kind=int_kind) :: n + character(len=*),parameter :: subname='(compute_calendar_data)' - days_since_calz = int(tsec/secday) + if (ayear < 0) then + write(nu_diag,*) trim(subname),' ERROR in ayear = ',ayear + call abort_ice(subname//'ERROR: in ayear') + endif - if (dayyr == 360) then + if (size(adaymo) /= months_per_year .or. & + size(adaycal) /= months_per_year+1 ) then + call abort_ice(subname//'ERROR: in argument sizes') + endif - year = int(days_since_calz/c360) - month = mod(int(days_since_calz/c30),12) + 1 - day = mod(int(days_since_calz),30) + 1 + if (trim(calendar_type) == trim(ice_calendar_gregorian)) then + + isleap = .false. ! not a leap year + if (mod(ayear, 4) == 0) isleap = .true. + if (mod(ayear,100) == 0) isleap = .false. + if (mod(ayear,400) == 0) isleap = .true. + + if (isleap) then + adaymo = daymo366 + else + adaymo = daymo365 + endif + elseif (trim(calendar_type) == trim(ice_calendar_360day)) then + adaymo = daymo360 else + adaymo = daymo365 + endif - if (use_leap_years) then - - year = int(days_since_calz/days_per_4c)*400 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_4c)*days_per_4c - - if (days_since_calz == 4*days_per_c) then - year = year + 400 - days_since_calz = days_per_y + 1 - else - year = year + int(days_since_calz/days_per_c)*100 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_c)*days_per_c - - year = year + int(days_since_calz/days_per_4y)*4 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_4y)*days_per_4y - - if (days_since_calz == 4*days_per_y) then - year = year + 4 - days_since_calz = days_per_y + 1 - else - year = year + int(days_since_calz/days_per_y) + 1 - days_since_calz = days_since_calz & - - int(days_since_calz/days_per_y)*days_per_y + c1 - endif - endif + adaycal(1) = 0 + do n = 1, months_per_year + adaycal(n+1) = adaycal(n) + adaymo(n) + enddo + adayyr=adaycal(months_per_year+1) - ! Ensure the calendar variables are correct for this year. - call set_calendar(year) + end subroutine compute_calendar_data - ! Calculate the month - month = 1 - do k = 1, 12 - if (days_since_calz > daycal(k)) month = k - enddo +!======================================================================= +! Compute elapsed days from 0000-01-01 to year1,month1,day1 +! 0000-01-01 is 0 elapsed days - ! Calculate the day of the month - day = days_since_calz - daycal(month) + integer function compute_elapsed_days(ayear,amonth,aday) - else ! Using fixed 365-day calendar - - year = int(days_since_calz/c365) - days_since_calz = days_since_calz - year*365 + 1 - - ! Calculate the month - month = 1 - do k = 1, 12 - if (days_since_calz > daycal365(k)) month = k - enddo + integer (kind=int_kind), intent(in) :: ayear ! year + integer (kind=int_kind), intent(in) :: amonth ! month + integer (kind=int_kind), intent(in) :: aday ! day - ! Calculate the day of the month - day = days_since_calz - daycal365(month) + ! Internal variable + integer (kind=int_kind) :: ced_nday, n + integer (kind=int_kind) :: lyear,lmonth,lday,lsec + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + character(len=*),parameter :: subname='(compute_elapsed_days)' + + ! use 0000-01-01 as base, year 0 is a leap year + ! this must be implemented consistent with set_calendar + + lyear = ayear + lmonth = amonth + lday = aday + lsec = 0 + + if (lyear < 0 .or. lmonth <= 0 .or. lday <= 0) then + write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',lyear,lmonth,lday + call abort_ice(subname//'ERROR: illegal date') + elseif (lmonth > months_per_year) then + call update_date(lyear,lmonth,lday,lsec) + endif - end if + ! compute days from year 0000-01-01 to year-01-01 + ! don't loop thru years for performance reasons + if (trim(calendar_type) == trim(ice_calendar_gregorian)) then + if (lyear == 0) then + ced_nday = 0 + else + ced_nday = lyear * 365 + 1 + (lyear-1)/4 - (lyear-1)/100 + (lyear-1)/400 + endif + else + ced_nday = lyear * daycal(months_per_year+1) + endif - end if + ! now compute days in this year + call compute_calendar_data(lyear,tdaymo,tdaycal,tdayyr) - end subroutine sec2time + do n = 1, lmonth-1 + ced_nday = ced_nday + tdaymo(n) + enddo -!======================================================================= + if (lday <= tdaymo(lmonth)) then + ced_nday = ced_nday + lday - 1 + else + write(nu_diag,*) trim(subname),' ERROR for year,month,day = ',ayear,amonth,aday + call abort_ice(subname//'ERROR: illegal day in month') + endif -! Set the "days per month", "days per year", etc variables for the -! current year. -! -! authors: Craig MacLachlan, UK Met Office + compute_elapsed_days = ced_nday - subroutine set_calendar(year) + end function compute_elapsed_days - integer (kind=int_kind), intent(in) :: year ! current year +!======================================================================= +! Compute time in seconds from input calendar date +! relative to year_init, month_init, day_init, sec_init unless _ref values passed in +! For santity, must pass all four ref values or none - ! Internal variable - logical (kind=log_kind) :: isleap ! Leap year logical - character(len=*),parameter :: subname='(set_calendar)' + subroutine calendar_date2time(ayear,amon,aday,asec,atimesecs,year_ref,mon_ref,day_ref,sec_ref) + + integer(kind=int_kind), intent(in) :: & + ayear,amon,aday,asec ! year, month, day, sec of ttimesecs + real (kind=dbl_kind), intent(out) :: atimesecs ! seconds since init date + integer(kind=int_kind), intent(in), optional :: & + year_ref,mon_ref,day_ref,sec_ref ! year, month, day, sec reference time - isleap = .false. ! not a leap year - if (mod(year, 4) == 0) isleap = .true. - if (mod(year,100) == 0) isleap = .false. - if (mod(year,400) == 0) isleap = .true. - - ! Ensure the calendar is set correctly - if (isleap) then - daycal = daycal366 - daymo = daymo366 - dayyr=real(daycal(13), kind=dbl_kind) - days_per_year=int(dayyr) + ! Internal variable + real (kind=dbl_kind) :: secday + integer (kind=int_kind) :: elapsed_days ! since beginning this run + integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref ! local reference year, month, day, sec + integer (kind=int_kind) :: cnt + character(len=*),parameter :: subname='(calendar_date2time)' + + ! set reference date and check that 0 or 4 optional arguments are passed + cnt = 0 + if (present(year_ref)) then + lyear_ref = year_ref + cnt = cnt + 1 + else + lyear_ref = year_init + endif + if (present(mon_ref)) then + lmon_ref = mon_ref + cnt = cnt + 1 + else + lmon_ref = month_init + endif + if (present(day_ref)) then + lday_ref = day_ref + cnt = cnt + 1 + else + lday_ref = day_init + endif + if (present(sec_ref)) then + lsec_ref = sec_ref + cnt = cnt + 1 else - daycal = daycal365 - daymo = daymo365 - dayyr=real(daycal(13), kind=dbl_kind) - days_per_year=int(dayyr) + lsec_ref = sec_init endif + if (cnt /= 0 .and. cnt /= 4) then + write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 ' + call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4') + endif + + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + elapsed_days = compute_days_between(lyear_ref,lmon_ref,lday_ref,ayear,amon,aday) + atimesecs = real(elapsed_days,kind=dbl_kind)*secday + & + real(asec,kind=dbl_kind) - real(lsec_ref,kind=dbl_kind) - end subroutine set_calendar + end subroutine calendar_date2time !======================================================================= +! Compute calendar date from input time in seconds +! relative to year_init, month_init, day_init, sec_init or ref data if passed. +! For sanity, require all four or no ref values. +! Implemented to minimize accumulating errors and avoid overflows +! and perform well. - real(kind=dbl_kind) function hc_jday(iyear,imm,idd,ihour) -!-------------------------------------------------------------------- -! converts "calendar" date to HYCOM julian day: -! 1) year,month,day,hour (4 arguments) -! 2) year,doy,hour (3 arguments) + subroutine calendar_time2date(atimesecs,ayear,amon,aday,asec,year_ref,mon_ref,day_ref,sec_ref) + + real (kind=dbl_kind), intent(in) :: atimesecs ! seconds since init date + integer(kind=int_kind), intent(out) :: & + ayear,amon,aday,asec ! year, month, day, sec of timesecs + integer(kind=int_kind), intent(in), optional :: & + year_ref,mon_ref,day_ref,sec_ref ! year, month, day, sec reference time + + ! Internal variable + integer (kind=int_kind) :: ndays + integer (kind=int_kind) :: tyear, tmon, tday, tsec ! temporaries + integer (kind=int_kind) :: tdaymo (months_per_year) ! days per month + integer (kind=int_kind) :: tdaycal(months_per_year+1) ! day count per month + integer (kind=int_kind) :: tdayyr ! days in year + real (kind=dbl_kind) :: secday, rdays, ltimesecs + integer (kind=int_kind) :: lyear_ref,lmon_ref,lday_ref,lsec_ref ! local reference year, month, day, sec + integer (kind=int_kind) :: cnt + character(len=*),parameter :: subname='(calendar_time2date)' + + call icepack_query_parameters(secday_out=secday) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & + file=__FILE__, line=__LINE__) + + ! we could allow negative atimesecs, but this shouldn't be needed + if (atimesecs < 0._dbl_kind) then + write(nu_diag,*) trim(subname),' ERROR in atimesecs ',atimesecs + call abort_ice(subname//'ERROR: in atimesecs') + endif + + ! set reference date and check that 0 or 4 optional arguments are passed + cnt = 0 + if (present(year_ref)) then + lyear_ref = year_ref + cnt = cnt + 1 + else + lyear_ref = year_init + endif + if (present(mon_ref)) then + lmon_ref = mon_ref + cnt = cnt + 1 + else + lmon_ref = month_init + endif + if (present(day_ref)) then + lday_ref = day_ref + cnt = cnt + 1 + else + lday_ref = day_init + endif + if (present(sec_ref)) then + lsec_ref = sec_ref + cnt = cnt + 1 + else + lsec_ref = sec_init + endif + if (cnt /= 0 .and. cnt /= 4) then + write(nu_diag,*) trim(subname),' ERROR in ref args, must pass 0 or 4 ' + call abort_ice(subname//'ERROR: in ref args, must pass 0 or 4') + endif + +! ------------------------------------------------------------------- +! tcraig, this is risky because atimesecs is real and could be very large +! ayear = lyear_ref +! amon = lmon_ref +! aday = lday_ref +! asec = lsec_ref ! -! HYCOM model day is calendar days since 31/12/1900 -!-------------------------------------------------------------------- - real(kind=dbl_kind) :: dtime - integer(kind=int_kind) :: iyear,iyr,imm,idd,idoy,ihr - integer(kind=int_kind), optional :: ihour - - if (present(ihour)) then - !----------------- - ! yyyy mm dd HH - !----------------- - iyr=iyear-1901 - if (mod(iyr,4)==3) then - dtime = floor(365.25_dbl_kind*iyr)*c1 + daycal366(imm)*c1 + idd*c1 + ihour/24._dbl_kind - else - dtime = floor(365.25_dbl_kind*iyr)*c1 + daycal365(imm)*c1 + idd*c1 + ihour/24._dbl_kind - endif - - else - !----------------- - ! yyyy DOY HH - !----------------- - ihr = idd ! redefine input - idoy = imm ! redefine input - iyr = iyear - 1901 - dtime = floor(365.25_dbl_kind*iyr)*c1 + idoy*c1 + ihr/24._dbl_kind - - endif - - hc_jday=dtime - - return - end function hc_jday +! call update_date(ayear,amon,aday,asec,dsec=nint(atimesecs)) +! return +! ------------------------------------------------------------------- + + ! initial guess + tyear = lyear_ref + tmon = 1 + tday = 1 + tsec = 0 + + ! add initial seconds to timesecs and treat lsec_ref as zero + ltimesecs = atimesecs + real(lsec_ref,kind=dbl_kind) + + ! first estimate of tyear + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + rdays = ltimesecs/secday + tyear = tyear + int(rdays)/tdayyr + + ! reduce estimate of tyear if ndays > rdays + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + if (ndays > int(rdays)) then + tyear = tyear - (ndays - int(rdays))/tdayyr - 1 + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + endif + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + + ! compute residual days, switch to integers, compute date + rdays = ltimesecs/secday + tday = int(rdays) - ndays + 1 + + do while (tday > tdaymo(tmon)) + tday = tday - tdaymo(tmon) + tmon = tmon + 1 + do while (tmon > months_per_year) + tmon = tmon - months_per_year + tyear = tyear + 1 + call compute_calendar_data(tyear,tdaymo,tdaycal,tdayyr) + enddo + enddo + + ndays = compute_days_between(lyear_ref,lmon_ref,lday_ref,tyear,tmon,tday) + tsec = int(ltimesecs - real(ndays,kind=dbl_kind)*secday) + if (tsec > secday) then + write(nu_diag,*) trim(subname),' ERROR in seconds, ',tyear,tmon,tday,tsec + call abort_ice(subname//'ERROR: in seconds') + endif + + ayear = tyear + amon = tmon + aday = tday + asec = tsec + + end subroutine calendar_time2date !======================================================================= diff --git a/cicecore/shared/ice_distribution.F90 b/cicecore/shared/ice_distribution.F90 index 8c5808820..1a23b63be 100644 --- a/cicecore/shared/ice_distribution.F90 +++ b/cicecore/shared/ice_distribution.F90 @@ -12,7 +12,7 @@ module ice_distribution use ice_kinds_mod use ice_domain_size, only: max_blocks use ice_communicate, only: my_task, master_task, create_communicator - use ice_blocks, only: nblocks_x, nblocks_y, nblocks_tot + use ice_blocks, only: nblocks_x, nblocks_y, nblocks_tot, debug_blocks use ice_exit, only: abort_ice use ice_fileunits, only: nu_diag @@ -154,8 +154,6 @@ subroutine create_local_block_ids(block_ids, distribution) integer (int_kind) :: & n, bcount ! dummy counters - logical (log_kind) :: dbug - character(len=*),parameter :: subname='(create_local_block_ids)' !----------------------------------------------------------------------- @@ -178,15 +176,14 @@ subroutine create_local_block_ids(block_ids, distribution) ! !----------------------------------------------------------------------- -! dbug = .true. - dbug = .false. if (bcount > 0) then do n=1,size(distribution%blockLocation) if (distribution%blockLocation(n) == my_task+1) then block_ids(distribution%blockLocalID(n)) = n - if (dbug) then - write(nu_diag,*) subname,'block id, proc, local_block: ', & + if (debug_blocks .and. my_task == master_task) then + write(nu_diag,'(2a,3i8)') & + subname,' block id, proc, local_block: ', & block_ids(distribution%blockLocalID(n)), & distribution%blockLocation(n), & distribution%blockLocalID(n) @@ -402,7 +399,7 @@ subroutine ice_distributionGet(distribution,& numLocalBlocks ! number of blocks distributed to this ! local processor - integer (int_kind), dimension(:), pointer, optional :: & + integer (int_kind), dimension(:), optional :: & blockLocation ,&! processor location for all blocks blockLocalID ,&! local block id for all blocks blockGlobalID ! global block id for each local block @@ -422,7 +419,7 @@ subroutine ice_distributionGet(distribution,& if (present(blockLocation)) then if (associated(distribution%blockLocation)) then - blockLocation => distribution%blockLocation + blockLocation = distribution%blockLocation else call abort_ice(subname//'ERROR: blockLocation not allocated') return @@ -575,7 +572,11 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) nprocsX, &! num of procs in x for global domain nprocsY, &! num of procs in y for global domain numBlocksXPerProc, &! num of blocks per processor in x - numBlocksYPerProc ! num of blocks per processor in y + numBlocksYPerProc, &! num of blocks per processor in y + numBlocksPerProc ! required number of blocks per processor + + character(len=char_len) :: & + numBlocksPerProc_str ! required number of blocks per processor (as string) character(len=*),parameter :: subname='(create_distrb_cart)' @@ -628,6 +629,14 @@ function create_distrb_cart(nprocs, workPerBlock) result(newDistrb) numBlocksXPerProc = (nblocks_x-1)/nprocsX + 1 numBlocksYPerProc = (nblocks_y-1)/nprocsY + 1 + ! Check if max_blocks is too small + numBlocksPerProc = numBlocksXPerProc * numBlocksYPerProc + if (numBlocksPerProc > max_blocks) then + write(numBlocksPerProc_str, '(i2)') numBlocksPerProc + call abort_ice(subname//'ERROR: max_blocks too small (need at least '//trim(numBlocksPerProc_str)//')') + return + endif + do j=1,nprocsY do i=1,nprocsX processor = (j-1)*nprocsX + i ! number the processors @@ -786,6 +795,8 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) maxWork = maxval(workPerBlock) if (numOcnBlocks <= 2*nprocs) then + if (my_task == master_task) & + write(nu_diag,*) subname,' 1d rake on entire distribution' allocate(priority(nblocks_tot), stat=istat) if (istat > 0) then @@ -807,7 +818,7 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) end do end do - allocate(workTmp(nblocks_tot), procTmp(nblocks_tot), stat=istat) + allocate(workTmp(nprocs), procTmp(nprocs), stat=istat) if (istat > 0) then call abort_ice( & 'create_distrb_rake: error allocating procTmp') @@ -841,6 +852,8 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) !---------------------------------------------------------------------- else + if (my_task == master_task) & + write(nu_diag,*) subname,' rake in each direction' call proc_decomposition(dist%nprocs, nprocsX, nprocsY) @@ -996,6 +1009,10 @@ function create_distrb_rake(nprocs, workPerBlock) result(newDistrb) if (pid > 0) then procTmp(pid) = procTmp(pid) + 1 + if (procTmp(pid) > max_blocks) then + call abort_ice(subname//'ERROR: max_blocks too small') + return + endif newDistrb%blockLocalID (n) = procTmp(pid) newDistrb%blockIndex(pid,procTmp(pid)) = n else @@ -1413,7 +1430,7 @@ end function create_distrb_spiralcenter function create_distrb_wghtfile(nprocs, workPerBlock) result(newDistrb) ! This function creates a distribution of blocks across processors -! using a simple wghtfile algorithm. Mean for prescribed ice or +! using a simple wghtfile algorithm. Meant for prescribed ice or ! standalone CAM mode. integer (int_kind), intent(in) :: & @@ -2094,8 +2111,6 @@ function create_distrb_spacecurve(nprocs,work_per_block) ii,extra,tmp1, &! loop tempories used for s1,ig ! partitioning curve - logical, parameter :: Debug = .FALSE. - type (factor_t) :: xdim,ydim integer (int_kind) :: it,jj,i2,j2 @@ -2189,9 +2204,9 @@ function create_distrb_spacecurve(nprocs,work_per_block) call GenSpaceCurve(Mesh) Mesh = Mesh + 1 ! make it 1-based indexing - if(Debug) then - if(my_task ==0) call PrintCurve(Mesh) - endif +! if (debug_blocks) then +! if (my_task == master_task) call PrintCurve(Mesh) +! endif !----------------------------------------------- ! Reindex the SFC to address internal sub-blocks @@ -2238,8 +2253,8 @@ function create_distrb_spacecurve(nprocs,work_per_block) endif enddo nblocks=ii - if(Debug) then - if(my_task==0) call PrintCurve(Mesh3) + if (debug_blocks) then + if (my_task == master_task) call PrintCurve(Mesh3) endif !---------------------------------------------------- @@ -2258,8 +2273,8 @@ function create_distrb_spacecurve(nprocs,work_per_block) ! ! First region gets nblocksL+1 blocks per partition ! Second region gets nblocksL blocks per partition - if(Debug) print *,'nprocs,extra,nblocks,nblocksL,s1: ', & - nprocs,extra,nblocks,nblocksL,s1 +! if(debug_blocks) write(nu_diag,*) 'nprocs,extra,nblocks,nblocksL,s1: ', & +! nprocs,extra,nblocks,nblocksL,s1 !----------------------------------------------------------- ! Use the SFC to partition the blocks across processors @@ -2304,6 +2319,10 @@ function create_distrb_spacecurve(nprocs,work_per_block) if(pid>0) then proc_tmp(pid) = proc_tmp(pid) + 1 + if (proc_tmp(pid) > max_blocks) then + call abort_ice(subname//'ERROR: max_blocks too small') + return + endif dist%blockLocalID(n) = proc_tmp(pid) dist%blockIndex(pid,proc_tmp(pid)) = n else @@ -2326,11 +2345,11 @@ function create_distrb_spacecurve(nprocs,work_per_block) endif enddo - if(Debug) then - if(my_task==0) print *,'dist%blockLocation:= ',dist%blockLocation - print *,'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & - nblocks_tot,nblocks,proc_tmp(my_task+1) - endif +! if (debug_blocks) then +! if (my_task == master_task) write(nu_diag,*) 'dist%blockLocation:= ',dist%blockLocation +! write(nu_diag,*) 'IAM: ',my_task,' SpaceCurve: Number of blocks {total,local} :=', & +! nblocks_tot,nblocks,proc_tmp(my_task+1) +! endif !--------------------------------- ! Deallocate temporary arrays !--------------------------------- diff --git a/cicecore/shared/ice_init_column.F90 b/cicecore/shared/ice_init_column.F90 index b3937c0cd..1362e055e 100644 --- a/cicecore/shared/ice_init_column.F90 +++ b/cicecore/shared/ice_init_column.F90 @@ -188,7 +188,7 @@ subroutine init_shortwave swgrid, igrid use ice_blocks, only: block, get_block, nx_block, ny_block use ice_calendar, only: dt, calendar_type, & - days_per_year, nextsw_cday, yday, sec + days_per_year, nextsw_cday, yday, msec use ice_diagnostics, only: npnt, print_points, pmloc, piloc, pjloc use ice_domain, only: nblocks, blocks_ice use ice_flux, only: alvdf, alidf, alvdr, alidr, & @@ -356,7 +356,7 @@ subroutine init_shortwave calendar_type=calendar_type, & days_per_year=days_per_year, & nextsw_cday=nextsw_cday, yday=yday, & - sec=sec, & + sec=msec, & kaer_tab=kaer_tab, kaer_bc_tab=kaer_bc_tab(:,:), & waer_tab=waer_tab, waer_bc_tab=waer_bc_tab(:,:), & gaer_tab=gaer_tab, gaer_bc_tab=gaer_bc_tab(:,:), & @@ -408,7 +408,7 @@ subroutine init_shortwave do i = ilo, ihi if (aicen(i,j,n,iblk) > puny) then - + alvdf(i,j,iblk) = alvdf(i,j,iblk) & + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk) alidf(i,j,iblk) = alidf(i,j,iblk) & @@ -417,7 +417,7 @@ subroutine init_shortwave + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk) alidr(i,j,iblk) = alidr(i,j,iblk) & + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk) - + netsw = swvdr(i,j,iblk) + swidr(i,j,iblk) & + swvdf(i,j,iblk) + swidf(i,j,iblk) if (netsw > puny) then ! sun above horizon @@ -428,12 +428,12 @@ subroutine init_shortwave albpnd(i,j,iblk) = albpnd(i,j,iblk) & + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk) endif - + apeff_ai(i,j,iblk) = apeff_ai(i,j,iblk) & + apeffn(i,j,n,iblk)*aicen(i,j,n,iblk) snowfrac(i,j,iblk) = snowfrac(i,j,iblk) & + snowfracn(i,j,n,iblk)*aicen(i,j,n,iblk) - + endif ! aicen > puny enddo ! i diff --git a/cicecore/shared/ice_spacecurve.F90 b/cicecore/shared/ice_spacecurve.F90 index 78b256b8f..931b2312b 100644 --- a/cicecore/shared/ice_spacecurve.F90 +++ b/cicecore/shared/ice_spacecurve.F90 @@ -13,12 +13,14 @@ module ice_spacecurve ! !USES: use ice_kinds_mod + use ice_blocks, only: debug_blocks use ice_communicate, only: my_task, master_task use ice_exit, only: abort_ice use ice_fileunits use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted implicit none + private ! !PUBLIC TYPES: @@ -30,13 +32,13 @@ module ice_spacecurve ! !PUBLIC MEMBER FUNCTIONS: - public :: GenSpaceCurve, & - IsLoadBalanced + public :: GenSpaceCurve public :: Factor, & IsFactorable, & PrintFactor, & ProdFactor, & + PrintCurve, & MatchFactor ! !PRIVATE MEMBER FUNCTIONS: @@ -60,8 +62,6 @@ module ice_spacecurve maxdim, &! dimensionality of entire space vcnt ! visitation count - logical :: verbose=.FALSE. - type (factor_t), public :: fact ! stores the factorization !EOP @@ -118,8 +118,6 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(Cinco)' !----------------------------------------------------------------------- @@ -136,12 +134,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Cinco: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Cinco: After Position [0,0] ',pos endif !-------------------------------------------------------------- @@ -153,12 +151,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,0] ',pos endif !-------------------------------------------------------------- @@ -170,12 +168,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,0] ',pos endif !-------------------------------------------------------------- @@ -187,12 +185,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,1] ',pos endif !-------------------------------------------------------------- @@ -204,12 +202,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,2] ',pos endif !-------------------------------------------------------------- @@ -221,12 +219,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,2] ',pos endif !-------------------------------------------------------------- @@ -238,12 +236,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,1] ',pos endif !-------------------------------------------------------------- @@ -255,12 +253,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,1] ',pos endif !-------------------------------------------------------------- @@ -272,12 +270,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,2] ',pos endif !-------------------------------------------------------------- @@ -289,12 +287,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,30) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,30) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,3] ',pos endif !-------------------------------------------------------------- @@ -306,12 +304,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,31) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,31) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [0,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [0,4] ',pos endif !-------------------------------------------------------------- @@ -323,12 +321,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,32) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,32) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,4] ',pos endif !-------------------------------------------------------------- @@ -340,12 +338,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,33) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,33) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [1,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [1,3] ',pos endif !-------------------------------------------------------------- @@ -357,12 +355,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,34) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,34) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,3] ',pos endif !-------------------------------------------------------------- @@ -374,12 +372,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,35) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,35) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [2,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [2,4] ',pos endif !-------------------------------------------------------------- @@ -391,12 +389,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,36) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,36) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,4] ',pos endif !-------------------------------------------------------------- @@ -408,12 +406,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,37) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,37) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,4] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,4] ',pos endif !-------------------------------------------------------------- @@ -425,12 +423,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,38) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,38) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,3] ',pos endif !-------------------------------------------------------------- @@ -442,12 +440,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,39) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,39) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,3] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,3] ',pos endif !-------------------------------------------------------------- @@ -459,12 +457,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,40) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,40) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,2] ',pos endif !-------------------------------------------------------------- @@ -476,12 +474,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,41) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,41) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,2] ',pos endif !-------------------------------------------------------------- @@ -493,12 +491,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,42) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,42) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,1] ',pos endif !-------------------------------------------------------------- @@ -510,12 +508,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,43) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,43) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,1] ',pos endif !-------------------------------------------------------------- @@ -527,12 +525,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = md if(ll .gt. 1) then - if(debug) write(*,44) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,44) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [3,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [3,0] ',pos endif !-------------------------------------------------------------- @@ -544,12 +542,12 @@ recursive function Cinco(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,45) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,45) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'After Position [4,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'After Position [4,0] ',pos endif 21 format('Call Cinco Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -632,8 +630,6 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(PeanoM)' !----------------------------------------------------------------------- @@ -650,12 +646,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,0] ',pos endif @@ -667,12 +663,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,1] ',pos endif !-------------------------------------------------------------- @@ -683,12 +679,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [0,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [0,2] ',pos endif !-------------------------------------------------------------- @@ -699,12 +695,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,2] ',pos endif @@ -717,12 +713,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = -lmd if(ll .gt. 1) then - if(debug) write(*,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,25) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,2] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,2] ',pos endif !-------------------------------------------------------------- @@ -734,12 +730,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,26) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,1] ',pos endif !-------------------------------------------------------------- @@ -751,12 +747,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,27) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,1] ',pos endif @@ -769,12 +765,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = -lmd if(ll .gt. 1) then - if(debug) write(*,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,28) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [1,0] ',pos endif !-------------------------------------------------------------- @@ -786,12 +782,12 @@ recursive function PeanoM(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,29) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'PeanoM: After Position [2,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'PeanoM: After Position [2,0] ',pos endif 21 format('Call PeanoM Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -858,8 +854,6 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ltype, &! type of SFC on next level ll ! next level down - logical :: debug = .FALSE. - character(len=*),parameter :: subname='(Hilbert)' !----------------------------------------------------------------------- @@ -875,12 +869,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = lmd if(ll .gt. 1) then - if(debug) write(*,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,21) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [0,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [0,0] ',pos endif @@ -892,12 +886,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) lja = lma ljd = lmd if(ll .gt. 1) then - if(debug) write(*,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,22) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [0,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [0,1] ',pos endif @@ -910,12 +904,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = -md if(ll .gt. 1) then - if(debug) write(*,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,23) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [1,1] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [1,1] ',pos endif !-------------------------------------------------------------- @@ -927,12 +921,12 @@ recursive function Hilbert(l,type,ma,md,ja,jd) result(ierr) ljd = jd if(ll .gt. 1) then - if(debug) write(*,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd + if(debug_blocks .and. my_task==master_task) write(nu_diag,24) ll-1,pos(0),pos(1),lma,lmd,lja,ljd ierr = GenCurve(ll-1,ltype,lma,lmd,lja,ljd) - if(debug) call PrintCurve(ordered) + if(debug_blocks .and. my_task==master_task) call PrintCurve(ordered) else ierr = IncrementCurve(lja,ljd) - if(debug) print *,'Hilbert: After Position [1,0] ',pos + if(debug_blocks .and. my_task==master_task) write(nu_diag,*) 'Hilbert: After Position [1,0] ',pos endif 21 format('Call Hilbert Pos [0,0] Level ',i1,' at (',i2,',',i2,')',4(i3)) @@ -1048,6 +1042,7 @@ function log2( n) end function log2 !*********************************************************************** +#ifdef UNDEPRECATE_IsLoadBalanced !BOP ! !IROUTINE: IsLoadBalanced ! !INTERFACE: @@ -1095,7 +1090,7 @@ function IsLoadBalanced(nelem,npart) !----------------------------------------------------------------------- end function IsLoadBalanced - +#endif !*********************************************************************** !BOP ! !IROUTINE: GenCurve @@ -1128,6 +1123,7 @@ function GenCurve(l,type,ma,md,ja,jd) result(ierr) !EOP !BOC + logical, save :: f2=.true., f3=.true., f5=.true. ! first calls character(len=*),parameter :: subname='(GenCurve)' !----------------------------------------------------------------------- @@ -1137,11 +1133,17 @@ function GenCurve(l,type,ma,md,ja,jd) result(ierr) !------------------------------------------------- if(type == 2) then + if (f2 .and. my_task == master_task) write(nu_diag,*) subname,' calling Hilbert (2)' ierr = Hilbert(l,type,ma,md,ja,jd) + f2 = .false. elseif ( type == 3) then + if (f3 .and. my_task == master_task) write(nu_diag,*) subname,' calling PeanoM (3)' ierr = PeanoM(l,type,ma,md,ja,jd) + f3 = .false. elseif ( type == 5) then + if (f5 .and. my_task == master_task) write(nu_diag,*) subname,' calling Cinco (5)' ierr = Cinco(l,type,ma,md,ja,jd) + f5 = .false. endif !EOP @@ -1210,7 +1212,7 @@ subroutine MatchFactor(fac1,fac2,val,found) found = .false. val1 = FirstFactor(fac1) -!JMD print *,'Matchfactor: found value: ',val1 +!JMD write(nu_diag,*)'Matchfactor: found value: ',val1 found = FindandMark(fac2,val1,.true.) tmp = FindandMark(fac1,val1,found) if (found) then @@ -1245,10 +1247,10 @@ subroutine PrintFactor(msg,fac) integer (int_kind) :: i character(len=*),parameter :: subname='(PrintFactor)' - write(*,*) subname,' ' - write(*,*) subname,'msg = ',trim(msg) - write(*,*) subname,(fac%factors(i),i=1,fac%numfact) - write(*,*) subname,(fac%used(i),i=1,fac%numfact) + write(nu_diag,*) subname,' ' + write(nu_diag,*) subname,'msg = ',trim(msg) + write(nu_diag,*) subname,(fac%factors(i),i=1,fac%numfact) + write(nu_diag,*) subname,(fac%used(i),i=1,fac%numfact) end subroutine PrintFactor @@ -1448,6 +1450,9 @@ subroutine map(l) maxdim=d vcnt=0 + ! tcx, if l is 0, then fact has no factors, just return + if (l == 0) return + type = fact%factors(l) ierr = GenCurve(l,type,0,1,0,1) @@ -1492,113 +1497,113 @@ subroutine PrintCurve(Mesh) gridsize = SIZE(Mesh,dim=1) - write(*,*) subname,":" + write(nu_diag,*) subname,":",gridsize if(gridsize == 2) then - write (*,*) "A Level 1 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,2) Mesh(1,i),Mesh(2,i) + write(nu_diag,2) Mesh(1,i),Mesh(2,i) enddo else if(gridsize == 3) then - write (*,*) "A Level 1 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 1 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,3) Mesh(1,i),Mesh(2,i),Mesh(3,i) + write(nu_diag,3) Mesh(1,i),Mesh(2,i),Mesh(3,i) enddo else if(gridsize == 4) then - write (*,*) "A Level 2 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 2 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,4) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i) + write(nu_diag,4) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i) enddo else if(gridsize == 5) then - write (*,*) "A Level 1 Cinco Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,5) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i) + write(nu_diag,5) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i),Mesh(5,i) enddo else if(gridsize == 6) then - write (*,*) "A Level 1 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,6) Mesh(1,i),Mesh(2,i),Mesh(3,i), & + write(nu_diag,6) Mesh(1,i),Mesh(2,i),Mesh(3,i), & Mesh(4,i),Mesh(5,i),Mesh(6,i) enddo else if(gridsize == 8) then - write (*,*) "A Level 3 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 3 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,8) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,8) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i) enddo else if(gridsize == 9) then - write (*,*) "A Level 2 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 2 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,9) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,9) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i) enddo else if(gridsize == 10) then - write (*,*) "A Level 1 Hilbert and Level 1 Cinco Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 1 Cinco Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,10) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,10) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i) enddo else if(gridsize == 12) then - write (*,*) "A Level 2 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,12) Mesh(1,i),Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,12) Mesh(1,i),Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i),Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i) enddo else if(gridsize == 15) then - write (*,*) "A Level 1 Peano and Level 1 Cinco Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 1 Peano and Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,15) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,15) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i) enddo else if(gridsize == 16) then - write (*,*) "A Level 4 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 4 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,16) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & + write(nu_diag,16) Mesh(1,i),Mesh(2,i),Mesh(3,i),Mesh(4,i), & Mesh(5,i),Mesh(6,i),Mesh(7,i),Mesh(8,i), & Mesh(9,i),Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i) enddo else if(gridsize == 18) then - write (*,*) "A Level 1 Hilbert and Level 2 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 1 Hilbert and Level 2 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,18) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,18) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & Mesh(17,i),Mesh(18,i) enddo else if(gridsize == 20) then - write (*,*) "A Level 2 Hilbert and Level 1 Cinco Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Hilbert and Level 1 Cinco Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,20) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,20) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i) enddo else if(gridsize == 24) then - write (*,*) "A Level 3 Hilbert and Level 1 Peano Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 3 Hilbert and Level 1 Peano Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,24) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,24) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1606,10 +1611,10 @@ subroutine PrintCurve(Mesh) Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i) enddo else if(gridsize == 25) then - write (*,*) "A Level 2 Cinco Curve:" - write (*,*) "------------------------------------------" + write (nu_diag,*) "A Level 2 Cinco Curve:" + write (nu_diag,*) "------------------------------------------" do i=1,gridsize - write(*,25) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,25) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1618,10 +1623,10 @@ subroutine PrintCurve(Mesh) Mesh(25,i) enddo else if(gridsize == 27) then - write (*,*) "A Level 3 Peano Meandering Curve:" - write (*,*) "---------------------------------" + write (nu_diag,*) "A Level 3 Peano Meandering Curve:" + write (nu_diag,*) "---------------------------------" do i=1,gridsize - write(*,27) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,27) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1629,11 +1634,24 @@ subroutine PrintCurve(Mesh) Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & Mesh(25,i),Mesh(26,i),Mesh(27,i) enddo + else if(gridsize == 30) then + write (nu_diag,*) "A Level 1 Cinco and Level 1 Peano and Level 1 Hilbert Curve:" + write (nu_diag,*) "---------------------------------" + do i=1,gridsize + write(nu_diag,30) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & + Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & + Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & + Mesh(17,i),Mesh(18,i),Mesh(19,i),Mesh(20,i), & + Mesh(21,i),Mesh(22,i),Mesh(23,i),Mesh(24,i), & + Mesh(25,i),Mesh(26,i),Mesh(27,i),Mesh(28,i), & + Mesh(29,i),Mesh(30,i) + enddo else if(gridsize == 32) then - write (*,*) "A Level 5 Hilbert Curve:" - write (*,*) "------------------------" + write (nu_diag,*) "A Level 5 Hilbert Curve:" + write (nu_diag,*) "------------------------" do i=1,gridsize - write(*,32) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & + write(nu_diag,32) Mesh(1,i), Mesh(2,i), Mesh(3,i), Mesh(4,i), & Mesh(5,i), Mesh(6,i), Mesh(7,i), Mesh(8,i), & Mesh(9,i), Mesh(10,i),Mesh(11,i),Mesh(12,i), & Mesh(13,i),Mesh(14,i),Mesh(15,i),Mesh(16,i), & @@ -1659,6 +1677,7 @@ subroutine PrintCurve(Mesh) 24 format('|',24(i3,'|')) 25 format('|',25(i3,'|')) 27 format('|',27(i3,'|')) +30 format('|',30(i4,'|')) 32 format('|',32(i4,'|')) !EOC @@ -1711,7 +1730,13 @@ subroutine GenSpaceCurve(Mesh) fact = factor(gridsize) level = fact%numfact - if(verbose) print *,'GenSpacecurve: level is ',level + if (debug_blocks .and. my_task==master_task .and. my_task==master_task) then + write(nu_diag,*) subname,' dim,size = ',dim,gridsize + write(nu_diag,*) subname,' numfact = ',level + call printfactor(subname,fact) + call flush_fileunit(nu_diag) + endif + allocate(ordered(gridsize,gridsize)) !-------------------------------------------- @@ -1730,61 +1755,10 @@ subroutine GenSpaceCurve(Mesh) deallocate(pos,ordered) -!EOP -!----------------------------------------------------------------------- - end subroutine GenSpaceCurve - recursive subroutine qsort(a) - - integer, intent(inout) :: a(:) - integer :: split - character(len=*),parameter :: subname='(qsort)' - - if(SIZE(a) > 1) then - call partition(a,split) - call qsort(a(:split-1)) - call qsort(a(split:)) - endif - - end subroutine qsort - - subroutine partition(a,marker) - - INTEGER, INTENT(IN OUT) :: a(:) - INTEGER, INTENT(OUT) :: marker - INTEGER :: left, right, pivot, temp - character(len=*),parameter :: subname='(partition)' - - pivot = (a(1) + a(size(a))) / 2 ! Average of first and last elements to prevent quadratic - left = 0 ! behavior with sorted or reverse sorted data - right = size(a) + 1 - - DO WHILE (left < right) - right = right - 1 - DO WHILE (a(right) > pivot) - right = right-1 - END DO - left = left + 1 - DO WHILE (a(left) < pivot) - left = left + 1 - END DO - IF (left < right) THEN - temp = a(left) - a(left) = a(right) - a(right) = temp - END IF - END DO - - IF (left == right) THEN - marker = left + 1 - ELSE - marker = left - END IF - - end subroutine partition - - +!EOC +!----------------------------------------------------------------------- end module ice_spacecurve diff --git a/cicecore/version.txt b/cicecore/version.txt index e16cf8bfe..cfd991555 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.1.4 +CICE 6.2.0 diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 7b39d5c8d..e0b7799d6 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -75,7 +75,7 @@ AR := ar .SUFFIXES: .SUFFIXES: .F90 .F .c .o -.PHONY: all cice libcice targets target db_files db_flags clean realclean +.PHONY: all cice libcice targets target db_files db_flags clean realclean helloworld calchk all: $(EXEC) cice: $(EXEC) @@ -92,7 +92,9 @@ cice: $(EXEC) targets: @echo " " - @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean, targets, db_files, db_flags" + @echo "Supported Makefile Targets are: cice, libcice, makdep, depends, clean, realclean" + @echo " Diagnostics: targets, db_files, db_flags" + @echo " Unit Tests : helloworld, calchk" target: targets db_files: @@ -134,6 +136,20 @@ $(DEPGEN): $(OBJS_DEPGEN) @ echo "Building makdep" $(SCC) -o $@ $(CFLAGS_HOST) $< +#------------------------------------------------------------------------------- +# unit tests +#------------------------------------------------------------------------------- + +# this builds all dependent source code automatically even though only a subset might actually be used +# this is no different than the cice target and in fact the binary is called cice +# it exists just to create separation as needed for unit tests +calchk: $(EXEC) + +# this builds just a subset of source code specified explicitly and requires a separate target +HWOBJS := helloworld.o +helloworld: $(HWOBJS) + $(LD) -o $(EXEC) $(LDFLAGS) $(HWOBJS) $(ULIBS) $(SLIBS) + #------------------------------------------------------------------------------- # build rules: MACFILE, cmd-line, or env vars must provide the needed macros #------------------------------------------------------------------------------- diff --git a/configuration/scripts/cice.batch.csh b/configuration/scripts/cice.batch.csh index 6d1f735a4..902abb56b 100755 --- a/configuration/scripts/cice.batch.csh +++ b/configuration/scripts/cice.batch.csh @@ -105,11 +105,20 @@ cat >> ${jobfile} << EOFB EOFB else if (${ICE_MACHINE} =~ onyx*) then +# special for onyx with 44 cores per node and constraint on mpiprocs +set tpn1 = ${taskpernode} +if (${taskpernode} < 44) set tpn1 = 22 +if (${taskpernode} < 22) set tpn1 = 11 +if (${taskpernode} < 11) set tpn1 = 4 +if (${taskpernode} < 4) set tpn1 = 2 +if (${taskpernode} < 2) set tpn1 = 1 +@ nn1 = ${ntasks} / ${tpn1} +if (${nn1} * ${tpn1} < ${ntasks}) @ nn1 = $nn1 + 1 cat >> ${jobfile} << EOFB #PBS -N ${ICE_CASENAME} #PBS -q ${queue} #PBS -A ${acct} -#PBS -l select=${nnodes}:ncpus=${maxtpn}:mpiprocs=${taskpernode} +#PBS -l select=${nn1}:ncpus=${maxtpn}:mpiprocs=${tpn1} #PBS -l walltime=${batchtime} #PBS -j oe ###PBS -M username@domain.com @@ -133,6 +142,22 @@ cat >> ${jobfile} << EOFB ###SBATCH --mail-user username@domain.com EOFB +else if (${ICE_MACHINE} =~ compy*) then +if (${runlength} <= 2) set queue = "short" +cat >> ${jobfile} <> ${jobfile} << EOFB #SBATCH -J ${ICE_CASENAME} diff --git a/configuration/scripts/cice.build b/configuration/scripts/cice.build index b9aed44fe..d75d74253 100755 --- a/configuration/scripts/cice.build +++ b/configuration/scripts/cice.build @@ -142,6 +142,10 @@ if !($?ICE_MACHINE_BLDTHRDS) then set ICE_MACHINE_BLDTHRDS = 1 endif +if (${directmake} == 0) then + set target = ${ICE_TARGET} +endif + if (${directmake} == 1) then echo "make ${target}" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ @@ -185,12 +189,12 @@ if (${quiet} == "true") then echo " quiet mode on... patience" ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ - DEPFILE=${ICE_CASEDIR}/makdep.c cice >& ${ICE_BLDLOG_FILE} + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} >& ${ICE_BLDLOG_FILE} set bldstat = ${status} else ${ICE_MACHINE_MAKE} -j ${ICE_MACHINE_BLDTHRDS} VPFILE=Filepath EXEC=${ICE_RUNDIR}/cice \ -f ${ICE_CASEDIR}/Makefile MACFILE=${ICE_CASEDIR}/Macros.${ICE_MACHCOMP} \ - DEPFILE=${ICE_CASEDIR}/makdep.c cice |& tee ${ICE_BLDLOG_FILE} + DEPFILE=${ICE_CASEDIR}/makdep.c ${target} |& tee ${ICE_BLDLOG_FILE} set bldstat = ${status} endif diff --git a/configuration/scripts/cice.launch.csh b/configuration/scripts/cice.launch.csh index a05b3a9d3..7d45a387f 100755 --- a/configuration/scripts/cice.launch.csh +++ b/configuration/scripts/cice.launch.csh @@ -81,6 +81,18 @@ srun --cpu-bind=cores ./cice >&! \$ICE_RUNLOG_FILE EOFR endif +#======= +else if (${ICE_MACHINE} =~ compy*) then +if (${ICE_COMMDIR} =~ serial*) then +cat >> ${jobfile} << EOFR +./cice >&! \$ICE_RUNLOG_FILE +EOFR +else +cat >> ${jobfile} << EOFR +srun --mpi=pmi2 --kill-on-bad-exit --cpu-bind=cores ./cice >&! \$ICE_RUNLOG_FILE +EOFR +endif + #======= else if (${ICE_MACHINE} =~ badger*) then if (${ICE_COMMDIR} =~ serial*) then diff --git a/configuration/scripts/cice.run.setup.csh b/configuration/scripts/cice.run.setup.csh index 901671a36..ea8efeb03 100755 --- a/configuration/scripts/cice.run.setup.csh +++ b/configuration/scripts/cice.run.setup.csh @@ -95,9 +95,15 @@ if ( \$status == 0 ) then echo "CICE run completed successfully" echo "\`date\` \${0}: CICE run completed successfully" >> \${ICE_CASEDIR}/README.case else - echo "CICE run did NOT complete" - echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case - exit -1 + grep 'COMPLETED SUCCESSFULLY' \${checkfile} + if ( \$status == 0 ) then + echo "Run completed successfully" + echo "\`date\` \${0}: Run completed successfully" >> \${ICE_CASEDIR}/README.case + else + echo "CICE run did NOT complete" + echo "\`date\` \${0}: CICE run did NOT complete" >> \${ICE_CASEDIR}/README.case + exit -1 + endif endif if ( \${diagtype} == 0) then diff --git a/configuration/scripts/cice.settings b/configuration/scripts/cice.settings index d2653a29d..3bd85f5f9 100755 --- a/configuration/scripts/cice.settings +++ b/configuration/scripts/cice.settings @@ -13,6 +13,7 @@ setenv ICE_RSTDIR ${ICE_RUNDIR}/restart setenv ICE_HSTDIR ${ICE_RUNDIR}/history setenv ICE_LOGDIR ${ICE_CASEDIR}/logs setenv ICE_DRVOPT standalone/cice +setenv ICE_TARGET cice setenv ICE_IOTYPE netcdf # binary, netcdf, pio1, pio2 setenv ICE_CLEANBUILD true setenv ICE_CPPDEFS "" diff --git a/configuration/scripts/cice_decomp.csh b/configuration/scripts/cice_decomp.csh index b20f8d129..aa1bb9a54 100755 --- a/configuration/scripts/cice_decomp.csh +++ b/configuration/scripts/cice_decomp.csh @@ -44,6 +44,17 @@ else if (${grid} == 'gbox128') then set blckx = 8; set blcky = 8 endif +else if (${grid} == 'gbox180') then + set nxglob = 180 + set nyglob = 180 + if (${cicepes} <= 1) then + set blckx = 180; set blcky = 180 + else if (${cicepes} <= 36) then + set blckx = 30; set blcky = 30 + else + set blckx = 9; set blcky = 9 + endif + else if (${grid} == 'gbox80') then set nxglob = 80 set nyglob = 80 @@ -98,6 +109,12 @@ else if (${grid} == 'tx1') then set blckx = 10; set blcky = 10 endif +# this is for unit testing +else if (${grid} == 'none') then + set nxglob = 1 + set nyglob = 1 + set blckx = 1; set blcky = 1 + else echo "${0:t}: ERROR unknown grid ${grid}" exit -9 diff --git a/configuration/scripts/ice_in b/configuration/scripts/ice_in index f34db14f0..e5fcb9177 100644 --- a/configuration/scripts/ice_in +++ b/configuration/scripts/ice_in @@ -1,9 +1,13 @@ &setup_nml days_per_year = 365 - use_leap_years = .false. - year_init = 1997 + use_leap_years = .true. + year_init = 2005 + month_init = 1 + day_init = 1 + sec_init = 0 istep0 = 0 dt = 3600.0 + npt_unit = '1' npt = 24 ndtd = 1 runtype = 'initial' @@ -25,6 +29,9 @@ diagfreq = 24 diag_type = 'stdout' diag_file = 'ice_diag.d' + debug_model = .false. + debug_model_step = 999999999 + forcing_diag = .false. print_global = .true. print_points = .true. conserv_check = .false. @@ -32,7 +39,6 @@ lonpnt(1) = 0. latpnt(2) = -65. lonpnt(2) = -45. - dbug = .false. histfreq = 'm','x','x','x','x' histfreq_n = 1 , 1 , 1 , 1 , 1 hist_avg = .true. @@ -196,6 +202,7 @@ natmiter = 5 atmiter_conv = 0.0d0 ustar_min = 0.0005 + iceruf = 0.0005 emissivity = 0.985 fbot_xfer_type = 'constant' update_ocn_f = .false. @@ -216,7 +223,7 @@ bgc_data_type = 'default' fe_data_type = 'default' ice_data_type = 'default' - fyear_init = 1997 + fyear_init = 2005 ycycle = 1 atm_data_format = 'bin' atm_data_dir = '/glade/u/home/tcraig/cice_data/' @@ -236,12 +243,14 @@ processor_shape = 'slenderX2' distribution_type = 'cartesian' distribution_wght = 'latitude' + distribution_wght_file = 'unknown' ew_boundary_type = 'cyclic' ns_boundary_type = 'open' maskhalo_dyn = .false. maskhalo_remap = .false. maskhalo_bound = .false. add_mpi_barriers = .false. + debug_blocks = .false. / &zbgc_nml diff --git a/configuration/scripts/machines/Macros.banting_intel b/configuration/scripts/machines/Macros.banting_intel index 7ed7f7b5a..2bab45725 100644 --- a/configuration/scripts/machines/Macros.banting_intel +++ b/configuration/scripts/machines/Macros.banting_intel @@ -13,7 +13,7 @@ FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceb #-xHost ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 diff --git a/configuration/scripts/machines/Macros.cheyenne_gnu b/configuration/scripts/machines/Macros.cheyenne_gnu index f46d80414..082130f77 100644 --- a/configuration/scripts/machines/Macros.cheyenne_gnu +++ b/configuration/scripts/machines/Macros.cheyenne_gnu @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -fcheck=bounds -finit-real=nan -fimplicit-none -ffpe-trap=invalid,zero,overflow +# FFLAGS += -O0 -g -fcheck=all -finit-real=snan -fimplicit-none -ffpe-trap=invalid,zero,overflow CFLAGS += -O0 endif diff --git a/configuration/scripts/machines/Macros.cheyenne_intel b/configuration/scripts/machines/Macros.cheyenne_intel index 243295487..52fc07ebb 100644 --- a/configuration/scripts/machines/Macros.cheyenne_intel +++ b/configuration/scripts/machines/Macros.cheyenne_intel @@ -12,7 +12,9 @@ FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -trace FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -link_mpi=dbg + FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -link_mpi=dbg +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays -link_mpi=dbg else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.compy_intel b/configuration/scripts/machines/Macros.compy_intel new file mode 100644 index 000000000..604337f59 --- /dev/null +++ b/configuration/scripts/machines/Macros.compy_intel @@ -0,0 +1,44 @@ +#============================================================================== +# Makefile macro for PNNL compy, 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 -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +else + FFLAGS += -O2 +endif + +SCC := icc +SFC := ifort +MPICC := mpiicc +MPIFC := mpiifort +ifeq ($(ICE_COMMDIR), mpi) + FC := $(MPIFC) + CC := $(MPICC) +else + FC := $(SFC) + CC := $(SCC) +endif +LD := $(FC) + +INC_NETCDF := $(NETCDF_PATH)/include +LIB_NETCDF := $(NETCDF_PATH)/lib + +INCLDIR := $(INCLDIR) -I$(INC_NETCDF) +SLIBS := -L$(LIB_NETCDF) -lnetcdf -lnetcdff + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 4acc4d3ba..9be1b9ab4 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -45,6 +45,7 @@ ifeq ($(strip $(SDKPATH)),) CFLAGS_HOST := else CFLAGS_HOST = -isysroot $(SDKPATH) + LD += -L$(SDKPATH)/usr/lib endif # Libraries to be passed to the linker diff --git a/configuration/scripts/machines/Macros.daley_intel b/configuration/scripts/machines/Macros.daley_intel index 897e6e057..a434ffdb3 100644 --- a/configuration/scripts/machines/Macros.daley_intel +++ b/configuration/scripts/machines/Macros.daley_intel @@ -13,7 +13,7 @@ FFLAGS := -fp-model source -convert big_endian -assume byterecl -ftz -traceb #-xHost ifeq ($(ICE_BLDDEBUG), true) - FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created + FFLAGS += -O0 -g -check -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays # -heap-arrays 1024 else FFLAGS += -O2 diff --git a/configuration/scripts/machines/Macros.gaffney_intel b/configuration/scripts/machines/Macros.gaffney_intel index 61dfe2518..7eccd36da 100644 --- a/configuration/scripts/machines/Macros.gaffney_intel +++ b/configuration/scripts/machines/Macros.gaffney_intel @@ -13,7 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -init=snan,arrays +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.koehr_intel b/configuration/scripts/machines/Macros.koehr_intel index 284d30c55..aee4b31a8 100644 --- a/configuration/scripts/machines/Macros.koehr_intel +++ b/configuration/scripts/machines/Macros.koehr_intel @@ -13,7 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -# FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created -init=snan,arrays +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel18 b/configuration/scripts/machines/Macros.mustang_intel18 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel18 +++ b/configuration/scripts/machines/Macros.mustang_intel18 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel19 b/configuration/scripts/machines/Macros.mustang_intel19 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel19 +++ b/configuration/scripts/machines/Macros.mustang_intel19 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.mustang_intel20 b/configuration/scripts/machines/Macros.mustang_intel20 index 5d1849488..28c1c1964 100644 --- a/configuration/scripts/machines/Macros.mustang_intel20 +++ b/configuration/scripts/machines/Macros.mustang_intel20 @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/Macros.onyx_intel b/configuration/scripts/machines/Macros.onyx_intel index 55f6fbbf5..92879ee82 100644 --- a/configuration/scripts/machines/Macros.onyx_intel +++ b/configuration/scripts/machines/Macros.onyx_intel @@ -13,6 +13,7 @@ FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +# FFLAGS += -O0 -g -check all -fpe0 -ftrapuv -fp-model except -check noarg_temp_created -init=snan,arrays else FFLAGS += -O2 endif diff --git a/configuration/scripts/machines/env.cheyenne_gnu b/configuration/scripts/machines/env.cheyenne_gnu index b17a15917..3bfe59c31 100755 --- a/configuration/scripts/machines/env.cheyenne_gnu +++ b/configuration/scripts/machines/env.cheyenne_gnu @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu diff --git a/configuration/scripts/machines/env.cheyenne_intel b/configuration/scripts/machines/env.cheyenne_intel index ce4eba29b..4a430622e 100755 --- a/configuration/scripts/machines/env.cheyenne_intel +++ b/configuration/scripts/machines/env.cheyenne_intel @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME intel diff --git a/configuration/scripts/machines/env.cheyenne_pgi b/configuration/scripts/machines/env.cheyenne_pgi index ba9ea498d..693692842 100755 --- a/configuration/scripts/machines/env.cheyenne_pgi +++ b/configuration/scripts/machines/env.cheyenne_pgi @@ -31,6 +31,9 @@ endif endif +limit coredumpsize unlimited +limit stacksize unlimited + setenv ICE_MACHINE_MACHNAME cheyenne setenv ICE_MACHINE_MACHINFO "SGI ICE XA Xeon E5-2697V4 Broadwell" setenv ICE_MACHINE_ENVNAME pgi diff --git a/configuration/scripts/machines/env.compy_intel b/configuration/scripts/machines/env.compy_intel new file mode 100755 index 000000000..fe3511aa6 --- /dev/null +++ b/configuration/scripts/machines/env.compy_intel @@ -0,0 +1,42 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source /share/apps/modules/init/csh + +module purge +module load intel/19.0.5 +module load intelmpi/2019u4 +module load netcdf/4.6.3 +module load hdf5/1.10.5 + +#setenv NETCDF_PATH ${NETCDF_DIR} +setenv NETCDF_PATH /share/apps/netcdf/4.6.3/intel/19.0.5 +setenv OMP_PROC_BIND true +setenv OMP_PLACES threads +setenv I_MPI_ADJUST_ALLREDUCE 1 +limit coredumpsize unlimited +limit stacksize unlimited + +endif + +setenv ICE_MACHINE_MACHNAME compy +setenv ICE_MACHINE_MACHINFO "PNNL Intel Xeon Skylake with 192 GB of DDR4 DRAM" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "intel/19.0.5 intelmpi/2019u4 netcdf/4.6.3" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /compyfs/$USER/CICE_RUNS +setenv ICE_MACHINE_INPUTDATA /compyfs/inputdata/cice-consortium/ +setenv ICE_MACHINE_BASELINE /compyfs/$USER/CICE_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch " +setenv ICE_MACHINE_ACCT e3sm +setenv ICE_MACHINE_QUEUE "slurm" +setenv ICE_MACHINE_TPNODE 40 # tasks per node +setenv ICE_MACHINE_BLDTHRDS 4 +setenv ICE_MACHINE_QSTAT "squeue --jobs=" + diff --git a/configuration/scripts/options/set_env.calchk b/configuration/scripts/options/set_env.calchk new file mode 100644 index 000000000..7dfe9612e --- /dev/null +++ b/configuration/scripts/options/set_env.calchk @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/calchk +setenv ICE_TARGET calchk diff --git a/configuration/scripts/options/set_env.helloworld b/configuration/scripts/options/set_env.helloworld new file mode 100644 index 000000000..60587fb91 --- /dev/null +++ b/configuration/scripts/options/set_env.helloworld @@ -0,0 +1,2 @@ +setenv ICE_DRVOPT unittest/helloworld +setenv ICE_TARGET helloworld diff --git a/configuration/scripts/options/set_nml.alt01 b/configuration/scripts/options/set_nml.alt01 index 98124b3f2..705fc8f63 100644 --- a/configuration/scripts/options/set_nml.alt01 +++ b/configuration/scripts/options/set_nml.alt01 @@ -15,7 +15,7 @@ kcatbound = 1 kitd = 0 ktherm = 0 conduct = 'bubbly' -kdyn = 0 +kdyn = 1 seabed_stress = .true. seabed_stress_method = 'probabilistic' use_bathymetry = .true. diff --git a/configuration/scripts/options/set_nml.alt03 b/configuration/scripts/options/set_nml.alt03 index 507f56a1b..a72696777 100644 --- a/configuration/scripts/options/set_nml.alt03 +++ b/configuration/scripts/options/set_nml.alt03 @@ -23,3 +23,4 @@ Ktens = 0. e_ratio = 2. seabed_stress = .true. use_bathymetry = .true. +l_mpond_fresh = .true. diff --git a/configuration/scripts/options/set_nml.alt05 b/configuration/scripts/options/set_nml.alt05 index 5a1f83110..5e439d9e0 100644 --- a/configuration/scripts/options/set_nml.alt05 +++ b/configuration/scripts/options/set_nml.alt05 @@ -8,6 +8,3 @@ tr_pond_topo = .false. tr_pond_lvl = .false. tr_aero = .false. shortwave = 'dEdd' -albedo_type = 'default' - - diff --git a/configuration/scripts/options/set_nml.alt06 b/configuration/scripts/options/set_nml.alt06 new file mode 100644 index 000000000..197f1f4a7 --- /dev/null +++ b/configuration/scripts/options/set_nml.alt06 @@ -0,0 +1,5 @@ +ncat = 7 +kcatbound = 3 +nslyr = 3 +ice_ic = 'default' +restart = .false. diff --git a/configuration/scripts/options/set_nml.bgcz b/configuration/scripts/options/set_nml.bgcz index 62c93f783..379a2fd63 100644 --- a/configuration/scripts/options/set_nml.bgcz +++ b/configuration/scripts/options/set_nml.bgcz @@ -26,5 +26,5 @@ tr_bgc_PON = .true. tr_bgc_hum = .true. tr_bgc_DON = .true. tr_bgc_Fe = .true. - - +# modal_aero = .true. +# dEdd_algae = .true. diff --git a/configuration/scripts/options/set_nml.bigdiag b/configuration/scripts/options/set_nml.bigdiag new file mode 100644 index 000000000..a98bc0c2b --- /dev/null +++ b/configuration/scripts/options/set_nml.bigdiag @@ -0,0 +1,8 @@ +forcing_diag = .true. +debug_model = .true. +debug_model_step = 4 +print_global = .true. +print_points = .true. +debug_blocks = .true. +latpnt(1) = 85. +lonpnt(1) = -150. diff --git a/configuration/scripts/options/set_nml.box2001 b/configuration/scripts/options/set_nml.box2001 index 79382d84e..84cac67b2 100644 --- a/configuration/scripts/options/set_nml.box2001 +++ b/configuration/scripts/options/set_nml.box2001 @@ -1,4 +1,5 @@ days_per_year = 360 +use_leap_years = .false. npt = 240 ice_ic = 'default' restart = .false. diff --git a/configuration/scripts/options/set_nml.boxadv b/configuration/scripts/options/set_nml.boxadv index 6fcdcc5df..49ab3f13c 100644 --- a/configuration/scripts/options/set_nml.boxadv +++ b/configuration/scripts/options/set_nml.boxadv @@ -18,4 +18,6 @@ kdyn = 2 kstrength = 0 krdg_partic = 0 krdg_redist = 0 +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxdyn b/configuration/scripts/options/set_nml.boxnodyn similarity index 88% rename from configuration/scripts/options/set_nml.boxdyn rename to configuration/scripts/options/set_nml.boxnodyn index 72e89db5c..e6de6be0d 100644 --- a/configuration/scripts/options/set_nml.boxdyn +++ b/configuration/scripts/options/set_nml.boxnodyn @@ -2,6 +2,7 @@ nilyr = 1 ice_ic = 'default' restart = .false. days_per_year = 360 +use_leap_years = .false. npt = 72 dumpfreq = 'd' dumpfreq_n = 2 @@ -25,3 +26,5 @@ revised_evp = .false. kstrength = 0 krdg_partic = 1 krdg_redist = 1 +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxrestore b/configuration/scripts/options/set_nml.boxrestore index d00ec41c8..6092a4d23 100644 --- a/configuration/scripts/options/set_nml.boxrestore +++ b/configuration/scripts/options/set_nml.boxrestore @@ -26,3 +26,5 @@ krdg_partic = 0 krdg_redist = 0 seabed_stress = .true. restore_ice = .true. +shortwave = 'ccsm3' +albedo_type = 'constant' diff --git a/configuration/scripts/options/set_nml.boxslotcyl b/configuration/scripts/options/set_nml.boxslotcyl index b13c8ca43..7d9f5e90e 100644 --- a/configuration/scripts/options/set_nml.boxslotcyl +++ b/configuration/scripts/options/set_nml.boxslotcyl @@ -11,6 +11,8 @@ kcatbound = 2 ew_boundary_type = 'open' ns_boundary_type = 'open' close_boundaries = .true. +tr_lvl = .false. +tr_pond_lvl = .false. ktherm = -1 kdyn = -1 kridge = -1 diff --git a/configuration/scripts/options/set_nml.debugblocks b/configuration/scripts/options/set_nml.debugblocks new file mode 100644 index 000000000..299dfff66 --- /dev/null +++ b/configuration/scripts/options/set_nml.debugblocks @@ -0,0 +1 @@ +debug_blocks = .true. diff --git a/configuration/scripts/options/set_nml.dspiralcenter b/configuration/scripts/options/set_nml.dspiralcenter new file mode 100644 index 000000000..fcf32dde7 --- /dev/null +++ b/configuration/scripts/options/set_nml.dspiralcenter @@ -0,0 +1 @@ +distribution_type = 'spiralcenter' diff --git a/configuration/scripts/options/set_nml.dwghtfile b/configuration/scripts/options/set_nml.dwghtfile new file mode 100644 index 000000000..d72b0fb8a --- /dev/null +++ b/configuration/scripts/options/set_nml.dwghtfile @@ -0,0 +1,3 @@ + distribution_type = 'wghtfile' + distribution_wght = 'file' + distribution_wght_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx1/cice62_gx1_wghtmask.nc' diff --git a/configuration/scripts/options/set_nml.gbox180 b/configuration/scripts/options/set_nml.gbox180 new file mode 100644 index 000000000..7b139f94a --- /dev/null +++ b/configuration/scripts/options/set_nml.gbox180 @@ -0,0 +1,4 @@ +ice_ic = 'default' +grid_type = 'rectangular' +atm_data_type = 'box2001' +ice_data_type = 'box2001' diff --git a/configuration/scripts/options/set_nml.gx1 b/configuration/scripts/options/set_nml.gx1 index e1d18dc8b..2e8d4f5b7 100644 --- a/configuration/scripts/options/set_nml.gx1 +++ b/configuration/scripts/options/set_nml.gx1 @@ -3,7 +3,7 @@ runtype = 'initial' year_init = 2005 use_leap_years = .true. use_restart_time = .false. -ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v5.nc' +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v6.2005-01-01.nc' grid_format = 'bin' grid_type = 'displaced_pole' grid_file = 'ICE_MACHINE_INPUTDATA/CICE_data/grid/gx1/grid_gx1.bin' @@ -17,5 +17,5 @@ atm_data_format = 'nc' atm_data_type = 'JRA55_gx1' atm_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/JRA55' precip_units = 'mks' -ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/COREII' +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' bgc_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/WOA/MONTHLY' diff --git a/configuration/scripts/options/set_nml.gx1apr b/configuration/scripts/options/set_nml.gx1apr new file mode 100644 index 000000000..c150d5815 --- /dev/null +++ b/configuration/scripts/options/set_nml.gx1apr @@ -0,0 +1,5 @@ +year_init = 2005 +month_init = 4 +day_init = 1 +sec_init = 0 +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v6.2005-04-01.nc' diff --git a/configuration/scripts/options/set_nml.gx1coreii b/configuration/scripts/options/set_nml.gx1coreii index 44b334194..13b8db59e 100644 --- a/configuration/scripts/options/set_nml.gx1coreii +++ b/configuration/scripts/options/set_nml.gx1coreii @@ -1,6 +1,7 @@ year_init = 1997 use_leap_years = .false. use_restart_time = .true. +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx1/iced_gx1_v5.nc' fyear_init = 2005 ycycle = 1 atm_data_format = 'bin' diff --git a/configuration/scripts/options/set_nml.gx1prod b/configuration/scripts/options/set_nml.gx1prod index a26af8102..f725c4367 100644 --- a/configuration/scripts/options/set_nml.gx1prod +++ b/configuration/scripts/options/set_nml.gx1prod @@ -1,7 +1,18 @@ -year_init = 1958 -dt = 3600 -npt = 87600 +year_init = 2005 +use_leap_years = .true. +npt_unit = 'y' +npt = 1 dumpfreq = 'm' -fyear_init = 1958 -ycycle = 52 -ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1' +fyear_init = 2005 +ycycle = 5 +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY/' +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'LKD' +ocn_data_type = 'ncar' +ocn_data_format = 'nc' +oceanmixed_ice = .true. +oceanmixed_file = 'ocean_forcing_clim_2D_gx1.20210330.nc' +tr_brine = .true. +f_taubx = 'm' +f_tauby = 'm' diff --git a/configuration/scripts/options/set_nml.gx3sep2 b/configuration/scripts/options/set_nml.gx3sep2 new file mode 100644 index 000000000..4eeefc64d --- /dev/null +++ b/configuration/scripts/options/set_nml.gx3sep2 @@ -0,0 +1,6 @@ +year_init = 2005 +month_init = 9 +day_init = 2 +sec_init = 7200 +use_leap_years = .true. +ice_ic = 'ICE_MACHINE_INPUTDATA/CICE_data/ic/gx3/iced_gx3_v6.2005-09-01.nc' diff --git a/configuration/scripts/options/set_nml.ml b/configuration/scripts/options/set_nml.ml new file mode 100644 index 000000000..0d00cbd5b --- /dev/null +++ b/configuration/scripts/options/set_nml.ml @@ -0,0 +1,7 @@ + +oceanmixed_ice = .true. +ocn_data_type = 'ncar' +ocn_data_format = 'nc' +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY' +oceanmixed_file = 'ocean_forcing_clim_2D_gx1.20210330.nc' + diff --git a/configuration/scripts/options/set_nml.run10day b/configuration/scripts/options/set_nml.run10day index deae3e993..05160c42d 100644 --- a/configuration/scripts/options/set_nml.run10day +++ b/configuration/scripts/options/set_nml.run10day @@ -1,4 +1,5 @@ -npt = 240 +npt_unit = 'd' +npt = 10 dumpfreq = 'd' dumpfreq_n = 10 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run1day b/configuration/scripts/options/set_nml.run1day index d7b70f973..a4ed751d5 100644 --- a/configuration/scripts/options/set_nml.run1day +++ b/configuration/scripts/options/set_nml.run1day @@ -1,4 +1,5 @@ -npt = 24 +npt_unit = 'd' +npt = 1 dumpfreq = 'd' dumpfreq_n = 1 diag_type = 'stdout' diff --git a/configuration/scripts/options/set_nml.run1year b/configuration/scripts/options/set_nml.run1year index 9a5baadfd..4e481870c 100644 --- a/configuration/scripts/options/set_nml.run1year +++ b/configuration/scripts/options/set_nml.run1year @@ -1,4 +1,5 @@ -npt = 8760 +npt_unit = 'y' +npt = 1 dumpfreq = 'm' dumpfreq_n = 12 diagfreq = 24 diff --git a/configuration/scripts/options/set_nml.run2day b/configuration/scripts/options/set_nml.run2day index 8129d59f6..60ece02f0 100644 --- a/configuration/scripts/options/set_nml.run2day +++ b/configuration/scripts/options/set_nml.run2day @@ -1,4 +1,5 @@ -npt = 48 +npt_unit = 'd' +npt = 2 dumpfreq = 'd' dumpfreq_n = 2 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run3day b/configuration/scripts/options/set_nml.run3day index 1fbf7a115..1a839468e 100644 --- a/configuration/scripts/options/set_nml.run3day +++ b/configuration/scripts/options/set_nml.run3day @@ -1,4 +1,5 @@ -npt = 72 +npt_unit = 'd' +npt = 3 dumpfreq = 'd' dumpfreq_n = 2 diag_type = 'stdout' diff --git a/configuration/scripts/options/set_nml.run3dt b/configuration/scripts/options/set_nml.run3dt index 102a19d80..4ff27ce22 100644 --- a/configuration/scripts/options/set_nml.run3dt +++ b/configuration/scripts/options/set_nml.run3dt @@ -1,3 +1,4 @@ +npt_unit = '1' npt = 3 dump_last = .true. histfreq = '1','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run5day b/configuration/scripts/options/set_nml.run5day index 4113c48e6..88d498a89 100644 --- a/configuration/scripts/options/set_nml.run5day +++ b/configuration/scripts/options/set_nml.run5day @@ -1,4 +1,5 @@ -npt = 120 +npt_unit = 'd' +npt = 5 dumpfreq = 'd' dumpfreq_n = 5 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run60day b/configuration/scripts/options/set_nml.run60day index 01fd59504..96f6dea1c 100644 --- a/configuration/scripts/options/set_nml.run60day +++ b/configuration/scripts/options/set_nml.run60day @@ -1,4 +1,5 @@ -npt = 1440 +npt_unit = 'd' +npt = 60 dumpfreq = 'd' dumpfreq_n = 30 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.run90day b/configuration/scripts/options/set_nml.run90day index 06db1a3d8..34d31166f 100644 --- a/configuration/scripts/options/set_nml.run90day +++ b/configuration/scripts/options/set_nml.run90day @@ -1,4 +1,5 @@ -npt = 2160 +npt_unit = 'd' +npt = 90 dumpfreq = 'd' dumpfreq_n = 30 histfreq = 'd','x','x','x','x' diff --git a/configuration/scripts/options/set_nml.seabedLKD b/configuration/scripts/options/set_nml.seabedLKD new file mode 100644 index 000000000..b53977d36 --- /dev/null +++ b/configuration/scripts/options/set_nml.seabedLKD @@ -0,0 +1,6 @@ +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'LKD' +histfreq = 'm','d','x','x','x' +f_taubx = 'md' +f_tauby = 'md' diff --git a/configuration/scripts/options/set_nml.seabedprob b/configuration/scripts/options/set_nml.seabedprob new file mode 100644 index 000000000..d6ad877ee --- /dev/null +++ b/configuration/scripts/options/set_nml.seabedprob @@ -0,0 +1,6 @@ +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'probabilistic' +histfreq = 'm','d','x','x','x' +f_taubx = 'md' +f_tauby = 'md' diff --git a/configuration/scripts/options/test_nml.restart1 b/configuration/scripts/options/test_nml.restart1 index 82f934720..6ab0bd88b 100644 --- a/configuration/scripts/options/test_nml.restart1 +++ b/configuration/scripts/options/test_nml.restart1 @@ -1,4 +1,5 @@ -npt = 240 +npt = 10 +npt_unit = 'd' dumpfreq = 'd' dumpfreq_n = 5 runtype = 'initial' diff --git a/configuration/scripts/options/test_nml.restart2 b/configuration/scripts/options/test_nml.restart2 index 4ae10c5a6..c12887eb0 100644 --- a/configuration/scripts/options/test_nml.restart2 +++ b/configuration/scripts/options/test_nml.restart2 @@ -1,4 +1,5 @@ -npt = 120 +npt = 5 +npt_unit = 'd' dumpfreq = 'd' dumpfreq_n = 5 runtype = 'continue' diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts old mode 100755 new mode 100644 index 1ed489730..c37750a31 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -5,6 +5,7 @@ smoke gx3 1x4 debug,diag1,run2day smoke gx3 4x1 debug,diag1,run5day restart gx3 8x2 debug smoke gx3 8x2 diag24,run1year,medium +smoke gx3 7x2 diag1,bigdiag,run1day 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 @@ -16,14 +17,18 @@ restart gx3 8x2 alt02 restart gx3 4x2 alt03 restart gx3 4x4 alt04 restart gx3 4x4 alt05 +restart gx3 8x2 alt06 restart gx3 6x2 alt01,debug,short restart gx3 8x2 alt02,debug,short restart gx3 4x2 alt03,debug,short smoke gx3 4x4 alt04,debug,short smoke gx3 4x4 alt05,debug,short +smoke gx3 8x2 alt06,debug,short +smoke gx3 10x2 debug,diag1,run5day,gx3sep2 +smoke gx3 7x2 diag1,bigdiag,run1day restart gbox128 4x2 short -restart gbox128 4x2 boxdyn,short -restart gbox128 4x2 boxdyn,short,debug +restart gbox128 4x2 boxnodyn,short +restart gbox128 4x2 boxnodyn,short,debug restart gbox128 2x2 boxadv,short smoke gbox128 2x2 boxadv,short,debug restart gbox128 4x4 boxrestore,short @@ -39,7 +44,9 @@ restart gx1 8x1 bgczclim,medium smoke gx1 24x1 medium,run90day,yi2008 smoke gx3 8x1 medium,run90day,yi2008 restart gx1 24x1 short -restart gx3 8x1 short +restart gx1 16x2 seabedLKD,gx1apr,medium,debug +restart gx1 15x2 seabedprob,medium +restart gx1 32x1 gx1prod,medium smoke gx3 4x2 fsd1,diag24,run5day,debug smoke gx3 8x2 fsd12,diag24,run5day,short restart gx3 4x2 fsd12,debug,short diff --git a/configuration/scripts/tests/baseline.script b/configuration/scripts/tests/baseline.script index a1ab4e055..6f13807e3 100644 --- a/configuration/scripts/tests/baseline.script +++ b/configuration/scripts/tests/baseline.script @@ -20,38 +20,93 @@ endif # Baseline comparing run if (${ICE_BASECOM} != ${ICE_SPVAL}) then - set test_dir = ${ICE_RUNDIR}/restart - set base_dir = ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/restart - - set baseline_log = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` set btimeloop = -1 set bdynamics = -1 set bcolumn = -1 - if (${baseline_log} != "" ) then - set btimeloop = `grep TimeLoop ${baseline_log} | grep Timer | cut -c 22-32` - set bdynamics = `grep Dynamics ${baseline_log} | grep Timer | cut -c 22-32` - set bcolumn = `grep Column ${baseline_log} | grep Timer | cut -c 22-32` - if (${btimeloop} == "") set btimeloop = -1 - if (${bdynamics} == "") set bdynamics = -1 - if (${bcolumn} == "") set bcolumn = -1 - endif - echo "" - echo "Regression Compare Mode:" - echo "base_dir: ${base_dir}" - echo "test_dir: ${test_dir}" + if (${ICE_TEST} == "unittest") then + set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` + set base_file = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + + echo "" + echo "bfb Log Compare Mode:" + echo "base_file: ${base_file}" + echo "test_file: ${test_file}" + + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} notcicefile + set bfbstatus = $status + + else + + set test_dir = ${ICE_RUNDIR}/restart + set base_dir = ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/restart + + set baseline_log = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + if (${baseline_log} != "" ) then + set btimeloop = `grep TimeLoop ${baseline_log} | grep Timer | cut -c 22-32` + set bdynamics = `grep Dynamics ${baseline_log} | grep Timer | cut -c 22-32` + set bcolumn = `grep Column ${baseline_log} | grep Timer | cut -c 22-32` + if (${btimeloop} == "") set btimeloop = -1 + if (${bdynamics} == "") set bdynamics = -1 + if (${bcolumn} == "") set bcolumn = -1 + endif + + echo "" + echo "Regression Compare Mode:" + echo "base_dir: ${base_dir}" + echo "test_dir: ${test_dir}" + + ${ICE_CASEDIR}/casescripts/comparebfb.csh ${base_dir} ${test_dir} + set bfbstatus = $status + + if ( ${bfbstatus} != 0 ) then + + set test_file = `ls -1t ${ICE_RUNDIR}/cice.runlog* | head -1` + set base_file = `ls -1t ${ICE_BASELINE}/${ICE_BASECOM}/${ICE_TESTNAME}/cice.runlog* | head -1` + + echo "" + echo "bfb Log Compare Mode:" + echo "base_file: ${base_file}" + echo "test_file: ${test_file}" + + if ("${base_file}" == "" || "${test_file}" == "" ) then + echo "MISS ${ICE_TESTNAME} complog ${ICE_BASECOM} missing-data" >> ${ICE_CASEDIR}/test_output + echo "Missing data" + else + ${ICE_CASEDIR}/casescripts/comparelog.csh ${base_file} ${test_file} + set logstatus = $status + + if ( ${logstatus} == 0 ) then + echo "PASS ${ICE_TESTNAME} complog ${ICE_BASECOM}" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset may be the same" + else if ( ${logstatus} == 1 ) then + echo "FAIL ${ICE_TESTNAME} complog ${ICE_BASECOM} different-data" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset are not the same" + else if ( ${logstatus} == 2 ) then + echo "MISS ${ICE_TESTNAME} complog ${ICE_BASECOM} missing-data" >> ${ICE_CASEDIR}/test_output + echo "Missing data" + else + echo "FAIL ${ICE_TESTNAME} complog ${ICE_BASECOM} usage-error" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset error in usage" + endif + endif + + endif + + endif - ${ICE_CASEDIR}/casescripts/comparebfb.csh ${base_dir} ${test_dir} - set bfbstatus = $status if ( ${bfbstatus} == 0 ) then echo "PASS ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn}" >> ${ICE_CASEDIR}/test_output echo "Regression baseline and test dataset are identical" + else if ( ${bfbstatus} == 1 ) then + echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} different-data" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset are different" else if ( ${bfbstatus} == 2 ) then echo "MISS ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} missing-data" >> ${ICE_CASEDIR}/test_output echo "Missing data" else - echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} different-data" >> ${ICE_CASEDIR}/test_output - echo "Regression baseline and test dataset are different" + echo "FAIL ${ICE_TESTNAME} compare ${ICE_BASECOM} ${btimeloop} ${bdynamics} ${bcolumn} usage-error" >> ${ICE_CASEDIR}/test_output + echo "Regression baseline and test dataset error in usage" endif endif @@ -88,12 +143,15 @@ if (${ICE_BFBCOMP} != ${ICE_SPVAL}) then if (${bfbstatus} == 0) then echo "PASS ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP}" >> ${ICE_CASEDIR}/test_output echo "bfb baseline and test dataset are identical" + else if (${bfbstatus} == 1) then + echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} different-data" >> ${ICE_CASEDIR}/test_output + echo "bfbcomp and test dataset are different" else if (${bfbstatus} == 2) then echo "MISS ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} missing-data" >> ${ICE_CASEDIR}/test_output echo "Missing data" else - echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} different-data" >> ${ICE_CASEDIR}/test_output - echo "bfbcomp and test dataset are different" + echo "FAIL ${ICE_TESTNAME} bfbcomp ${ICE_BFBCOMP} usage-error" >> ${ICE_CASEDIR}/test_output + echo "bfbcomp and test dataset usage error" endif endif diff --git a/configuration/scripts/tests/comparelog.csh b/configuration/scripts/tests/comparelog.csh index 8c1ff3a3c..d9e4a7a89 100755 --- a/configuration/scripts/tests/comparelog.csh +++ b/configuration/scripts/tests/comparelog.csh @@ -3,8 +3,9 @@ # Compare prognostic output in two log files #----------------------------------------------------------- -# usage: comparelog.csh base_file test_file +# usage: comparelog.csh base_file test_file [notcicefile] # does diff of two files +# optional 3rd argument indicates the file is not a cice file so diff entire thing # # Return Codes (depends on quality of error checking) # 0 = pass @@ -13,13 +14,26 @@ # 9 = error set filearg = 0 +set cicefile = 0 +set notcicefile = "notcicefile" if ( $#argv == 2 ) then + set cicefile = 1 set filearg = 1 set base_data = $argv[1] set test_data = $argv[2] -else + if ("$argv[1]" == "${notcicefile}") set filearg = 0 + if ("$argv[2]" == "${notcicefile}") set filearg = 0 +else if ( $#argv == 3 ) then + set cicefile = 0 + set filearg = 1 + set base_data = $argv[1] + set test_data = $argv[2] + if ("$argv[3]" != "${notcicefile}") set filearg = 0 +endif + +if (${filearg} == 0) then echo "Error in ${0}" - echo "Usage: ${0} " + echo "Usage: ${0} [notcicefile]" echo " does diff of two files" exit 9 endif @@ -28,7 +42,7 @@ set failure = 0 set base_out = "comparelog_base_out_file.log" set test_out = "comparelog_test_out_file.log" -if ($filearg == 1) then +if (${filearg} == 1) then echo "base_data: $base_data" echo "test_data: $test_data" if ( -f ${base_data} && -f ${test_data}) then @@ -38,12 +52,18 @@ if ($filearg == 1) then else touch ${base_out} - cat ${base_data} | grep -A 99999999 istep1: | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${base_out} touch ${test_out} - cat ${test_data} | grep -A 99999999 istep1: | grep -e istep1: -e = | grep -iv "min, max, sum" >&! ${test_out} + + if (${cicefile} == 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} + endif set basenum = `cat ${base_out} | wc -l` - set testnum = `cat ${base_out} | wc -l` + set testnum = `cat ${test_out} | wc -l` set filediff = `diff -w ${base_out} ${test_out} | wc -l` if (${basenum} > 0 && ${testnum} > 0) then diff --git a/configuration/scripts/tests/decomp_suite.ts b/configuration/scripts/tests/decomp_suite.ts index 4eb5394d9..9c82c5d27 100644 --- a/configuration/scripts/tests/decomp_suite.ts +++ b/configuration/scripts/tests/decomp_suite.ts @@ -1,15 +1,50 @@ # Test Grid PEs Sets BFB-compare restart gx3 4x2x25x29x4 dslenderX2 +restart gx1 64x1x16x16x10 dwghtfile +restart gbox180 16x1x6x6x60 dspacecurve,debugblocks decomp gx3 4x2x25x29x5 none sleep 30 -restart gx3 1x1x50x58x4 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 4x1x25x116x1 dslenderX1,thread restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 6x2x4x29x18 dspacecurve restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 8x2x8x10x20 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 6x2x50x58x1 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 4x2x19x19x10 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 1x20x5x29x80 dsectrobin,short restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 16x2x5x10x20 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x1x50x58x4 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 4x1x25x116x1 dslenderX1,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 6x2x4x29x18 dspacecurve restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 8x2x8x10x20 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 6x2x50x58x1 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 5x2x33x23x4 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 4x2x19x19x10 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 20x2x5x4x30 dsectrobin,short restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x5x10x20 drakeX2 restart_gx3_4x2x25x29x4_dslenderX2 restart gx3 8x2x8x10x20 droundrobin,maskhalo restart_gx3_4x2x25x29x4_dslenderX2 -restart gx3 1x4x25x29x16 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x4x25x29x16 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x8x30x20x32 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 1x1x120x125x1 droundrobin,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x1x1x800 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x2x2x200 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x3x3x100 droundrobin restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 16x2x8x8x80 dspiralcenter restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 10x1x10x29x4 dsquarepop,thread restart_gx3_4x2x25x29x4_dslenderX2 +restart gx3 8x1x25x29x4 drakeX2,thread restart_gx3_4x2x25x29x4_dslenderX2 + +smoke gx3 4x2x25x29x4 debug,run2day,dslenderX2 +smoke gx1 64x1x16x16x10 debug,run2day,dwghtfile +smoke gbox180 16x1x6x6x60 debug,run2day,dspacecurve,debugblocks +sleep 30 +smoke gx3 1x1x25x58x8 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 20x1x5x116x1 debug,run2day,dslenderX1,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 6x2x4x29x18 debug,run2day,dspacecurve smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x2x10x12x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 6x2x50x58x1 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 5x2x33x23x4 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 4x2x19x19x10 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 20x2x5x4x30 debug,run2day,dsectrobin,short smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x5x10x20 debug,run2day,drakeX2 smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x2x8x10x20 debug,run2day,droundrobin,maskhalo smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x6x25x29x16 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x8x30x20x32 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 1x1x120x125x1 debug,run2day,droundrobin,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x1x1x800 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x2x2x200 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x3x3x100 debug,run2day,droundrobin smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 16x2x8x8x80 debug,run2day,dspiralcenter smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 10x1x10x29x4 debug,run2day,dsquarepop,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day +smoke gx3 8x1x25x29x4 debug,run2day,drakeX2,thread smoke_gx3_4x2x25x29x4_debug_dslenderX2_run2day diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts old mode 100755 new mode 100644 index a17e3f625..6fe1f589a --- a/configuration/scripts/tests/io_suite.ts +++ b/configuration/scripts/tests/io_suite.ts @@ -7,6 +7,7 @@ restart gx3 16x2 gx3ncarbulk,alt02,histall,iobinary,precision8 #restart gx3 4x2 gx3ncarbulk,alt03,histall,iobinary restart gx3 8x4 gx3ncarbulk,alt04,histall,iobinary,precision8 restart gx3 4x4 gx3ncarbulk,alt05,histall,iobinary +restart gx3 14x2 gx3ncarbulk,alt06,histall,iobinary,precision8 restart gx3 32x1 gx3ncarbulk,bgcz,histall,iobinary,precision8 restart gx3 16x2 gx3ncarbulk,bgcskl,histall,iobinary restart gx3 14x2 gx3ncarbulk,isotope,histall,iobinary,precision8 @@ -18,6 +19,7 @@ restart gx3 15x2 alt02,histall,ionetcdf restart gx3 24x1 alt03,histall,ionetcdf,precision8 restart gx3 8x4 alt04,histall,ionetcdf,cdf64 restart gx3 8x4 alt05,histall,ionetcdf,precision8,cdf64 +restart gx3 16x2 alt06,histall,ionetcdf restart gx3 30x1 bgcz,histall,ionetcdf restart gx3 15x2 bgcskl,histall,ionetcdf,precision8 restart gx3 31x1 isotope,histall,ionetcdf,cdf64 @@ -29,6 +31,7 @@ restart gx3 32x1 alt02,histall,iopio1,precision8 restart gx3 24x1 alt03,histall,iopio1 restart gx3 8x4 alt04,histall,iopio1,precision8,cdf64 restart gx3 8x4 alt05,histall,iopio1,cdf64 +restart gx3 32x1 alt06,histall,iopio1,precision8 restart gx3 16x2 bgcz,histall,iopio1,precision8 restart gx3 30x1 bgcskl,histall,iopio1 restart gx3 8x4 isotope,histall,iopio1,precision8,cdf64 @@ -40,6 +43,7 @@ restart gx3 32x1 alt02,histall,iopio2,cdf64 restart gx3 24x1 alt03,histall,iopio2,precision8 restart gx3 8x4 alt04,histall,iopio2 restart gx3 8x4 alt05,histall,iopio2,precision8,cdf64 +restart gx3 16x2 alt06,histall,iopio2,cdf64 restart gx3 16x2 bgcz,histall,iopio2,cdf64 restart gx3 30x1 bgcskl,histall,iopio2,precision8 restart gx3 8x4 isotope,histall,iopio2 @@ -51,6 +55,7 @@ restart gx3 32x1 alt02,histall,iopio1p,precision8,cdf64 restart gx3 24x1 alt03,histall,iopio1p,cdf64 restart gx3 8x4 alt04,histall,iopio1p,precision8 restart gx3 8x4 alt05,histall,iopio1p +restart gx3 6x4 alt06,histall,iopio1p,precision8,cdf64 restart gx3 16x2 bgcz,histall,iopio1p,precision8,cdf64 restart gx3 30x1 bgcskl,histall,iopio1p,cdf64 restart gx3 8x4 isotope,histall,iopio1p,precision8 @@ -62,6 +67,7 @@ restart gx3 32x1 alt02,histall,iopio2p restart gx3 24x1 alt03,histall,iopio2p,precision8,cdf64 restart gx3 8x4 alt04,histall,iopio2p,cdf64 restart gx3 8x4 alt05,histall,iopio2p,precision8 +restart gx3 24x1 alt06,histall,iopio2p restart gx3 16x2 bgcz,histall,iopio2p restart gx3 30x1 bgcskl,histall,iopio2p,precision8,cdf64 restart gx3 8x4 isotope,histall,iopio2p,cdf64 diff --git a/configuration/scripts/tests/lcov_modify_source.sh b/configuration/scripts/tests/lcov_modify_source.sh new file mode 100755 index 000000000..ceadca4f4 --- /dev/null +++ b/configuration/scripts/tests/lcov_modify_source.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +filelist=`find cicecore icepack -type f -name "*.F90"` +LCOV_EXCL=" ! LCOV_EXCL_LINE" + +#echo $filelist + +for file in $filelist; do + + echo $file + ofile=${file}.orig + nfile=${file} + + mv ${file} ${file}.orig + + # line by line making sure each line has a trailing newline (-n) + # preserve whitespace (IFS) + # and include backslashes (-r) + IFS='' + contblock=0 + cat $ofile | while read -r line || [[ -n $line ]]; do + + if [[ $contblock == 1 ]]; then + # in a continuation block + if [[ $line =~ ^.*"&".*$ ]]; then + # found another continuation line, add exclude string and write out line + echo ${line} ${LCOV_EXCL} >> ${nfile} + else + # continuation block ends, write out line + contblock=0 + echo ${line} >> ${nfile} + fi + else + # not in a continuation block, write out line + echo ${line} >> ${nfile} + if [[ $line =~ ^\s*.*"&".*$ && ! $line =~ ^\s*( if ).*$ ]]; then + # new continuation block found + contblock=1 + fi + fi + + done + +done diff --git a/configuration/scripts/tests/nothread_suite.ts b/configuration/scripts/tests/nothread_suite.ts index afe1963b3..da1267e86 100644 --- a/configuration/scripts/tests/nothread_suite.ts +++ b/configuration/scripts/tests/nothread_suite.ts @@ -21,11 +21,13 @@ restart gx3 16x1 alt02 restart gx3 8x1 alt03 restart gx3 16x1 alt04 restart gx3 16x1 alt05 +restart gx3 20x1 alt06 restart gx3 18x1 alt01,debug,short restart gx3 20x1 alt02,debug,short restart gx3 24x1 alt03,debug,short smoke gx3 24x1 alt04,debug,short smoke gx3 32x1 alt05,debug,short +smoke gx3 16x1 alt06,debug,short restart gx3 16x1 isotope smoke gx3 6x1 isotope,debug smoke gx3 8x1 fsd1,diag24,run5day,debug @@ -34,8 +36,8 @@ restart gx3 12x1 fsd12,debug,short smoke gx3 20x1 fsd12ww3,diag24,run1day,medium restart gbox128 8x1 short -restart gbox128 16x1 boxdyn,short -restart gbox128 24x1 boxdyn,short,debug +restart gbox128 16x1 boxnodyn,short +restart gbox128 24x1 boxnodyn,short,debug restart gbox128 12x1 boxadv,short smoke gbox128 20x1 boxadv,short,debug restart gbox128 32x1 boxrestore,short diff --git a/configuration/scripts/tests/quick_suite.ts b/configuration/scripts/tests/quick_suite.ts index 9384f0333..48646673d 100644 --- a/configuration/scripts/tests/quick_suite.ts +++ b/configuration/scripts/tests/quick_suite.ts @@ -2,5 +2,5 @@ smoke gx3 8x2 diag1,run5day smoke gx3 1x1 diag1,run1day restart gbox128 8x1 diag1 -restart gx3 4x2 debug,diag1,run5day +restart gx3 4x2 debug,diag1 smoke gx3 4x1 diag1,run5day,thread smoke_gx3_8x2_diag1_run5day diff --git a/configuration/scripts/tests/report_results.csh b/configuration/scripts/tests/report_results.csh index 2eb3731d5..e1f3a7342 100755 --- a/configuration/scripts/tests/report_results.csh +++ b/configuration/scripts/tests/report_results.csh @@ -82,11 +82,11 @@ if ("${shrepo}" !~ "*cice-consortium*") then endif set noglob -set green = "\![#00C000](https://placehold.it/15/00C000/000000?text=+)" -set red = "\![#F00000](https://placehold.it/15/F00000/000000?text=+)" -set orange = "\![#FFA500](https://placehold.it/15/FFA500/000000?text=+)" -set yellow = "\![#FFE600](https://placehold.it/15/FFE600/000000?text=+)" -set gray = "\![#AAAAAA](https://placehold.it/15/AAAAAA/000000?text=+)" +set green = "\![#00C000](images/00C000.png)" +set red = "\![#F00000](images/F00000.png)" +set orange = "\![#FFA500](images/FFA500.png)" +set yellow = "\![#FFE600](images/FFE600.png)" +set gray = "\![#AAAAAA](images/AAAAAA.png)" unset noglob #============================================================== diff --git a/configuration/scripts/tests/test_unittest.script b/configuration/scripts/tests/test_unittest.script new file mode 100644 index 000000000..0fcd148a6 --- /dev/null +++ b/configuration/scripts/tests/test_unittest.script @@ -0,0 +1,24 @@ + +#---------------------------------------------------- +# Run the CICE model +# cice.run returns -1 if run did not complete successfully + +./cice.run +set res="$status" + +set log_file = `ls -t1 ${ICE_RUNDIR}/cice.runlog* | head -1` + +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 = FAIL +if ( $res == 0 ) then + set grade = PASS +endif + +echo "$grade ${ICE_TESTNAME} run " >> ${ICE_CASEDIR}/test_output +echo "$grade ${ICE_TESTNAME} test " >> ${ICE_CASEDIR}/test_output + diff --git a/configuration/scripts/tests/unittest_suite.ts b/configuration/scripts/tests/unittest_suite.ts new file mode 100644 index 000000000..2e9dcc7cf --- /dev/null +++ b/configuration/scripts/tests/unittest_suite.ts @@ -0,0 +1,4 @@ +# Test Grid PEs Sets BFB-compare +unittest gx3 1x1 helloworld +unittest gx3 1x1 calchk + diff --git a/configuration/tools/convert_restarts.f90 b/configuration/tools/cice4_restart_conversion/convert_restarts.f90 similarity index 100% rename from configuration/tools/convert_restarts.f90 rename to configuration/tools/cice4_restart_conversion/convert_restarts.f90 diff --git a/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py b/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py new file mode 100755 index 000000000..6cc796481 --- /dev/null +++ b/configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py @@ -0,0 +1,441 @@ +#! /usr/bin/env python3 + +import xesmf as xe +from netCDF4 import Dataset +import argparse +import os +import numpy as np +from datetime import datetime + +###################################################### +###################################################### +def make_regridder(lon1, lat1, lon2, lat2, method, periodic, grdname, + lon1_b=None, lat1_b=None, lon2_b=None, lat2_b=None): + ''' + make nearest neighbor xESMF regridder object. + input: + lon1: source longitudes (degrees) + lat1: source latitudes (degrees) + lon2: target longitudes (degrees) + lat2: target latitudes (degrees) + method: regridding method (bilinear, patch, conservative, nearest_s2d) + periodic: True if periodic longitudes, false if not + grdname: filename for regridder (Ugrid or Tgrid) + ''' + if method != "conservative": + # define grids for regridder + grid1 = {'lon' : lon1, 'lat' : lat1} + grid2 = {'lon' : lon2, 'lat' : lat2} + + + else: + # conservative needs boundary lon/lat + grid1 = {'lon' : lon1, 'lat' : lat1, + 'lon_b' : lon1_b, 'lat_b' : lat1_b} + + grid2 = {'lon' : lon2, 'lat' : lat2, + 'lon_b' : lon2_b, 'lat_b' : lat2_b} + + # make regridder + # here specify reuse_weights=False to re-generate weight file. + # if wanted to reuse file inteas of making int, + # check if file exists and change use_file_weights=True. + # see commented out example below + use_file_weights=False + + # check if regrid file exists. + # If so, reuse file instead of regenerating. + # if (os.path.isfile(blin_grid_name)): + # use_file_weights = True + + regridder = xe.Regridder(ds_in=grid1,ds_out=grid2, + method=method, + periodic=periodic, + filename=grdname, + reuse_weights=use_file_weights) + + + return regridder + +######################################### +######################################### +def halo_extrapolate(a,ew_bndy_type,ns_bndy_type): + ''' + Extrapolate to 'halo' cell as in CICE code + ice_boundary.F90:ice_HaloExtrapolate. + inputs: + a: array nx+1, ny+1 (nghost/nhalo hard-coded as 1 for now) + ew_bndy_type: east/west boundary type (cyclic, regional, etc) + ns_bndy_type: norh/south boundary type (cyclic, regional, etc) + + return: a with halo applied + ''' + + # get dimension of a + # expected to be 0:nx+nghost, 0:ny+nghost + nj, ni = a.shape # note with Python NetCDF is nj, ni order + # W/E edges + if ew_bndy_type == 'cyclic': + a[: ,0] = a[:,-2] # -2, since -1 is ghost cell + a[:,-1] = a[:, 1] # 1, since 0 is ghost cell + else: # if (trim(ew_bndy_type) /= 'cyclic') then + a[:, 0] = 2.0*a[:, 1] - a[:, 2] + a[:,-1] = 2.0*a[:,-2] - a[:,-3] + + # south edge + if ns_bndy_type == 'cyclic': + a[0,:] = a[-2,:] # -2, since -1 is ghost cell + else: + a[0,:] = 2.0*a[1,:] - a[2,:] + + # north edge treated a little different, depending + # on if bndy type is tripole + if ns_bndy_type == 'cyclic': + a[-1,:] = a[1,:] # 1, since 0 is ghost cell + + elif (ns_bndy_type != 'cyclic' and + ns_bndy_type != 'tripole' and + ns_bndy_type != 'tripoleT'): + + a[-1,:] = 2.0*a[-2,:] - a[-3,:] + + else: + pass # do nothing + + # return array with halo upated + return a + +######################################### +######################################### + +def Tlatlon(ulat,ulon,ew_bndy_type,ns_bndy_type): + ''' + Make TLAT/TLON from ULAT/ULON. + see ice_grid.F90:Tlatlon for method + Inputs: + ulat: U grid latitude in degrees + ulon: U grid longitude in degrees + + output: + tlat in degrees + tlon in degrees + ''' + + # method obtained from ice_grid.F90: subroutine Tlatlon + ulatcos = np.cos(np.deg2rad(ulat)) + ulatsin = np.sin(np.deg2rad(ulat)) + + uloncos = np.cos(np.deg2rad(ulon)) + ulonsin = np.sin(np.deg2rad(ulon)) + + # initialize array with nghost=1 on each side + nj, ni = ulatcos.shape # note: Python NetCDF is nj, ni order + print("Tlatlon nj, ni", nj, ni) + + nghost = 1 + workdims = (nj+2*nghost,ni+2*nghost) + #print("Tlatlon workdims", workdims) + + ulatcos1 = np.zeros(workdims,dtype='f8') + ulatsin1 = np.zeros(workdims,dtype='f8') + uloncos1 = np.zeros(workdims,dtype='f8') + ulonsin1 = np.zeros(workdims,dtype='f8') + + # fill middle of work arrays + ulatcos1[1:nj+1,1:ni+1] = ulatcos + ulatsin1[1:nj+1,1:ni+1] = ulatsin + + # fill middle of work arrays + ulatcos1[1:nj+1,1:ni+1] = ulatcos + ulatsin1[1:nj+1,1:ni+1] = ulatsin + + uloncos1[1:nj+1,1:ni+1] = uloncos + ulonsin1[1:nj+1,1:ni+1] = ulonsin + + # fill halos + ulatcos1 = halo_extrapolate(ulatcos1,ew_bndy_type,ns_bndy_type) + ulatsin1 = halo_extrapolate(ulatsin1,ew_bndy_type,ns_bndy_type) + uloncos1 = halo_extrapolate(uloncos1,ew_bndy_type,ns_bndy_type) + ulonsin1 = halo_extrapolate(ulonsin1,ew_bndy_type,ns_bndy_type) + + # now do computations as in ice_grid.F90:Tlatlon + + # x, y, z are full 2d + x = uloncos1 * ulatcos1 + y = ulonsin1 * ulatcos1 + z = ulatsin1 + + tx = 0.25*(x[0:nj, 0:ni ] + # x1 + x[0:nj, 1:ni+1] + # x2 + x[1:nj+1,0:ni ] + # x3 + x[1:nj+1,1:ni+1]) # x4 + + #print("Tlonlat: x.shape", x.shape) + #print("Tlonlat: tx.shape", tx.shape) + + + ty = 0.25*(y[0:nj, 0:ni ] + # y1 + y[0:nj, 1:ni+1] + # y2 + y[1:nj+1,0:ni ] + # y3 + y[1:nj+1,1:ni+1]) # y4 + + + tz = 0.25*(z[0:nj, 0:ni ] + # z1 + z[0:nj, 1:ni+1] + # z2 + z[1:nj+1,0:ni ] + # z3 + z[1:nj+1,1:ni+1]) # z4 + + da = np.sqrt(tx*tx + ty*ty + tz*tz) + + tz = tz/da + + tlon = np.arctan2(ty,tx) + tlat = np.arcsin(tz) + + # returnd tlat, tlon in degrees + return np.rad2deg(tlat), np.rad2deg(tlon) + +########################## +########################## + +def get_command_line_args(): + ''' + argument parser for command line arguments + ''' + + dstr = "Interplate JRA55 data" + parser = argparse.ArgumentParser(description=dstr) + + # add arguments + parser.add_argument("JRADTG", type=str, help="JRA55 file date time group") + parser.add_argument("dstgrid", type=str, help="Destination grid file (NetCDF)") + parser.add_argument("ncout", type=str, help="Output file name (NetCDF)") + + + # get the arguments + args = parser.parse_args() + + # return values + return args.JRADTG, args.dstgrid, args.ncout + + +################################ +################################ + +def get_jra55_nc_dict(): + ''' + Create dictionary that links the NetCDF variable name + with the file prefix. The file prefix is appended by + JRADTG from command line + ''' + # specify dictionary with dataset prefix names + jra55dict = {"TPRAT_GDS4_SFC_ave3h" : "fcst_phy2m.061_tprat.reg_tl319", # precip + "DSWRF_GDS4_SFC_ave3h" : "fcst_phy2m.204_dswrf.reg_tl319", # downward shortwave + "DLWRF_GDS4_SFC_ave3h" : "fcst_phy2m.205_dlwrf.reg_tl319", # downward longwave + "TMP_GDS4_HTGL" : "fcst_surf.011_tmp.reg_tl319" , # air temp + "UGRD_GDS4_HTGL" : "fcst_surf.033_ugrd.reg_tl319" , # u velocity + "VGRD_GDS4_HTGL" : "fcst_surf.034_vgrd.reg_tl319" , # v velocity + "SPFH_GDS4_HTGL" : "fcst_surf.051_spfh.reg_tl319"} # specify humidity + + + return jra55dict + +################################ +################################ + +def get_jra55_cice_var(): + ''' + Make dictionary relating JRA55 NetCDF variables + to CICE variables. + ''' + + # specify output variable names + # This is for current CICE expected names + # it might be better to change CICE in long run + cice_var = {"TPRAT_GDS4_SFC_ave3h" : "ttlpcp", + "DSWRF_GDS4_SFC_ave3h" : "glbrad", + "DLWRF_GDS4_SFC_ave3h" : "dlwsfc", + "TMP_GDS4_HTGL" : "airtmp", + "UGRD_GDS4_HTGL" : "wndewd", + "VGRD_GDS4_HTGL" : "wndnwd", + "SPFH_GDS4_HTGL" : "spchmd"} + + return cice_var + +################################ +################################ + +def init_ncout(ncout,nc1,llat,llon): + + ''' + Initialize output NetCDF file + with proper units and dimensions. + ''' + + dsout = Dataset(ncout,'w',format='NETCDF3_64BIT_OFFSET') + + # get dimensions from size of lat + (nlat,nlon) = llat.shape + + # create dimensions + time = dsout.createDimension('time',None) # unlimited + dim_j = dsout.createDimension('dim_j',nlat) + dim_i = dsout.createDimension('dim_i',nlon) + + # create time variable. + # note is defined as 'times' (with and s) to not conflict + # with dimension 'time' + times = dsout.createVariable('time','f8',('time',)) + times.units = nc1['initial_time0_hours'].units + times.calendar = 'gregorian' + + # loop over nc1 times + dates = [] + dates.append(nc1['initial_time0_hours'][0] + nc1['forecast_time1'][1]) + # loop over remaining + for h in nc1['initial_time0_hours'][1:-1]: + for ft in nc1['forecast_time1'][:]: + dates.append(h + ft) + + # include only first forecast_time of last initial time + dates.append(nc1['initial_time0_hours'][-1] + nc1['forecast_time1'][0]) + + # write dates to file + times[:] = dates + + # create LON/LAT variables + LON = dsout.createVariable('LON','f8',('dim_j','dim_i',)) + LON.units = 'degrees_east' + + LAT = dsout.createVariable('LAT','f8',('dim_j','dim_i',)) + LAT.units = 'degrees_north' + + # write LON, LAT to file + LON[:] = llon[:,:] + LAT[:] = llat[:,:] + + + return dsout + +################################ +################################ + + +# main subroutine +if __name__ == "__main__": + + # get jra dtg and ncout from command line + JRADTG, dstgrid, ncout = get_command_line_args() + + # get jra55 variable/filename prefix dictionary + jra55dict = get_jra55_nc_dict() + + # get dictionary linking jra55 variables names + # and CICE forcing varible names + cice_var = get_jra55_cice_var() + + # read input grid. + # use one of the jra55 files. + # it is assumed all JRA data are the same grid for later + fname = f"{jra55dict['TMP_GDS4_HTGL']:s}.{JRADTG:s}.nc" + print("opening dataset ", fname) + grid1_ds = Dataset(fname,'r',format='NETCDF3_64BIT_OFFSET') + lon1 = grid1_ds['g4_lon_3'][:] # 1D + lat1 = grid1_ds['g4_lat_2'][:] # 1D + + # open destination grid + # here it is assumed a CICE NetCDF file. + # the user can update as appropriate + print("Opening ", dstgrid) + grid2_ds = Dataset(dstgrid,'r',format='NETCDF3_64BIT_OFFSET') + ulon2 = grid2_ds["lon"][:,:] # 2D. Assumed ULON in degrees + ulat2 = grid2_ds["lat"][:,:] # 2D. Assumed ULAT in degrees + if np.max(np.abs(ulat2)) < 10. : + ulon2 = np.rad2deg(ulon2) + ulat2 = np.rad2deg(ulat2) + + # make tgrid from ugrid + ew_bndy_type = 'cyclic' + ns_bndy_type = 'open' + tlat2, tlon2 = Tlatlon(ulat2,ulon2,ew_bndy_type,ns_bndy_type) + + # make regridders + print("making bilinear regridder") + method = 'bilinear' + periodic = True + blin_grid_name = 'bilinear_jra55_gx3.nc' + rgrd_bilinear = make_regridder(lon1,lat1,tlon2,tlat2, + method,periodic,blin_grid_name) + + # setup output dataset by adding lat/lon + dsout = init_ncout(ncout,grid1_ds,tlat2,tlon2) + + # no longer need grid1, grid2 + grid1_ds.close() + grid2_ds.close() + + # do the regridding + # Loop over all the files using regridder from above + # and add to dataout + for var, fprefix in jra55dict.items(): + fname = f"{fprefix:s}.{JRADTG:s}.nc" + print("reading ", fname) + jra_ds = Dataset(fname,'r',format='NETCDF3_CLASSIC') + + # make output variable + data = dsout.createVariable(cice_var[var],'f4',('time','dim_j','dim_i')) + + # do interpolation + print("Interpolating ", var) + + if var.find('ave3h') > 0: # ave3r in var + # use bilinear here + d = rgrd_bilinear(jra_ds[var][:,:,:,:]) + + # write to file in correct time order + for t in range(d.shape[0]): + for n in range(d.shape[1]): + #print('indx (2*t)+n = ', (2*t)+n) + data[(2*t)+n,:,:] = d[t,n,:,:] + + else: + # instantaneous use bilinear + d = rgrd_bilinear(jra_ds[var][:,:,:,:]) + + # write to file in correct time order. + # note need to write 2nd forecast_time first. + # in this case first forecast_time is NaN + data[0,:,:] = d[0,1,:,:] + for t in range(1,d.shape[0]-1): + for n in range(d.shape[1]): + #print('indx (2*t)+n-1 = ', (2*t)+n-1) + data[(2*t)+n-1,:,:] = d[t,n,:,:] + + # write first forecast time of last initial time + # second forecast time is NAN + data[-1,:,:] = d[-1,0,:,:] + + # add coordinates attribute + data.coordinates = "LON LAT time" + data.long_name = jra_ds[var].long_name + data.units = jra_ds[var].units + + precip_factor = 1. / 86400. + + # Convert mm / day to kg/m^2/s. + if var.find('PRAT') > 0: + data[:] = data[:] * precip_factor + data.units = 'kg/m2/s' + else: + data.units = jra_ds[var].units + + # close jra55 file + jra_ds.close() + + + # write tou output file + # close output file + dsout.close() + + print("Done") + diff --git a/configuration/tools/jra55_datasets/make_forcing.csh b/configuration/tools/jra55_datasets/make_forcing.csh new file mode 100755 index 000000000..c57871a25 --- /dev/null +++ b/configuration/tools/jra55_datasets/make_forcing.csh @@ -0,0 +1,49 @@ +#!/bin/csh +# ----- +# This is a script that worked on NCAR's cheyenne in March, 2021. +# It converts raw JRA55 datasets to a format that CICE can use. +# This tools is documented in the CICE user guide. The +# tool interpolates to a CICE grid and does things like convert units. +# ----- +# The interp_jra55_ncdf_bilinar.py script was placed in "scripts_dir" +# The raw JRA55 datasets were placed in "jra55_data_dir" +# The CICE grid files were places in "jra55_data_dir" +# The model output was created in "output_data_dir" +# ----- +#PBS -N make_forcing +#PBS -q regular +#PBS -l select=1:ncpus=4:mpiprocs=4 +#PBS -l walltime=06:00:00 +#PBS -A P93300665 + +set scripts_dir = "/glade/work/tcraig/cice-consortium/cice.jra55_tool/configuration/tools/jra55_datasets" +set jra55_data_dir = "/glade/scratch/dbailey/JRA_DATA/" +set output_data_dir = "/glade/scratch/tcraig/JRA_DATA_output" +set grid = "gx3" +set cice_grid_file = "grid_gx3.nc" + +module load python/3.7.9 +source /glade/u/apps/opt/ncar_pylib/ncar_pylib.csh default +module load nco + +mkdir -p ${output_data_dir} +cd ${output_data_dir} + +ln -s ${jra55_data_dir}/fcst_*.nc . +ln -s ${jra55_data_dir}/grid_*.nc . + +ln -s ${scripts_dir}/interp_jra55_ncdf_bilinear.py . + +#foreach year ( 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 ) +foreach year ( 1997 ) + +./interp_jra55_ncdf_bilinear.py ${year}010100_${year}033121 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q1.nc +./interp_jra55_ncdf_bilinear.py ${year}040100_${year}063021 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q2.nc +./interp_jra55_ncdf_bilinear.py ${year}070100_${year}093021 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q3.nc +./interp_jra55_ncdf_bilinear.py ${year}100100_${year}123121 ${cice_grid_file} JRA55_${grid}_03hr_forcing_${year}-q4.nc + +ncrcat JRA55_${grid}_03hr_forcing_${year}-??.nc JRA55_${grid}_03hr_forcing_${year}.nc + +/bin/rm -f ${jra55_data_dir}/JRA55_${grid}_03hr_forcing_${year}-??.nc + +end diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 59ddc4122..9e2868947 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -139,8 +139,10 @@ either Celsius or Kelvin units). "daymo", "number of days in one month", "" "daycal", "day number at end of month", "" "days_per_year", ":math:`\bullet` number of days in one year", "365" + "day_init", ":math:`\bullet` the initial day of the month", "" "dbl_kind", "definition of double precision", "selected_real_kind(13)" - "dbug", ":math:`\bullet` write extra diagnostics", ".false." + "debug_model", "Logical that controls extended model point debugging.", "" + "debug_model_step", "Initial timestep for output associated with debug_model.", "" "Delta", "function of strain rates (see Section :ref:`dynam`)", "1/s" "default_season", "Season from which initial values of forcing are set.", "winter" "denom1", "combination of constants for stress equation", "" @@ -229,6 +231,7 @@ either Celsius or Kelvin units). "flw", "incoming longwave radiation", "W/m\ :math:`^2`" "flwout", "outgoing longwave radiation", "W/m\ :math:`^2`" "fm", "Coriolis parameter * mass in U cell", "kg/s" + "forcing_diag", ":math:`\bullet` write extra diagnostics for forcing inputs", ".false." "formdrag", ":math:`\bullet` calculate form drag", "" "fpond", "fresh water flux to ponds", "kg/m\ :math:`^2`/s" "fr_resp", "bgc respiration fraction", "0.05" @@ -258,9 +261,9 @@ either Celsius or Kelvin units). "fswthru_idr", "near IR direct shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_idf", "near IR diffuse shortwave penetrating to ocean", "W/m\ :math:`^2`" "fswthru_ai", "grid-box-mean shortwave penetrating to ocean (fswthru)", "W/m\ :math:`^2`" - "fyear", "current data year", "" - "fyear_final", "last data year", "" - "fyear_init", ":math:`\bullet` initial data year", "" + "fyear", "current forcing data year", "" + "fyear_final", "last forcing data year", "" + "fyear_init", ":math:`\bullet` initial forcing data year", "" "**G**", "", "" "gravit", "gravitational acceleration", "9.80616 m/s\ :math:`^2`" "grid_file", ":math:`\bullet` input file for grid info", "" @@ -313,7 +316,7 @@ either Celsius or Kelvin units). "ice_stderr", "unit number for standard error output", "" "ice_ref_salinity", "reference salinity for ice–ocean exchanges", "4. ppt" "icells", "number of grid cells with specified property (for vectorization)", "" - "iceruf", "ice surface roughness", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" + "iceruf", ":math:`\bullet` ice surface roughness at atmosphere interface", "5.\ :math:`\times`\ 10\ :math:`^{-4}` m" "icetmask", "ice extent mask (T-cell)", "" "iceumask", "ice extent mask (U-cell)", "" "idate", "the date at the end of the current time step (yyyymmdd)", "" @@ -378,18 +381,21 @@ either Celsius or Kelvin units). "max_blocks", "maximum number of blocks per processor", "" "max_ntrcr", "maximum number of tracers available", "5" "maxraft", "maximum thickness of ice that rafts", "1. m" - "mday", "day of the month", "" + "mday", "model day of the month", "" "meltb", "basal ice melt", "m" "meltl", "lateral ice melt", "m" "melts", "snow melt", "m" "meltt", "top ice melt", "m" "min_salin", "threshold for brine pockets", "0.1 ppt" "mlt_onset", "day of year that surface melt begins", "" - "month", "the month number", "" + "mmonth", "model month number", "" "monthp", "previous month number", "" + "month_init", ":math:`\bullet` the initial month", "" "mps_to_cmpdy", "m per s to cm per day conversion", "8.64\ :math:`\times`\ 10\ :math:`^6`" + "msec", "model seconds elasped into day", "" "mtask", "local processor number that writes debugging data", "" "mu_rdg", ":math:`\bullet` e-folding scale of ridged ice", "" + "myear", "model year", "" "my_task", "task ID for the current processor", "" "**N**", "", "" "n_aero", "number of aerosol species", "" @@ -416,7 +422,8 @@ either Celsius or Kelvin units). "nlt_bgc_[chem]", "ocean sources and sinks for biogeochemistry", "" "nml_filename", "namelist file name", "" "nprocs", ":math:`\bullet` total number of processors", "" - "npt", ":math:`\bullet` total number of time steps (dt)", "" + "npt", ":math:`\bullet` total run length values associate with npt_unit", "" + "npt_unit", "units of the run length, number set by npt", "" "ns_boundary_type", ":math:`\bullet` type of north-south boundary condition", "" "nslyr", "number of snow layers in each category", "" "nspint", "number of solar spectral intervals", "" @@ -443,7 +450,6 @@ either Celsius or Kelvin units). "nvarz", "number of category, vertical grid fields written to history", "" "nx(y)_block", "total number of gridpoints on block in x(y) direction", "" "nx(y)_global", "number of physical gridpoints in x(y) direction, global domain", "" - "nyr", "year number", "" "**O**", "", "" "ocean_bio", "concentrations of bgc constituents in the ocean", "" "oceanmixed_file", ":math:`\bullet` data file containing ocean forcing data", "" @@ -555,8 +561,8 @@ either Celsius or Kelvin units). "scale_factor", "scaling factor for shortwave radiation components", "" "seabed_stress", "if true, calculate seabed stress", "F" "seabed_stress_method", "method for calculating seabed stress (‘LKD’ or ‘probabilistic’)", "LKD" - "sec", "seconds elasped into idate", "" "secday", "number of seconds in a day", "86400." + "sec_init", ":math:`\bullet` the initial second", "" "shcoef", "transfer coefficient for sensible heat", "" "shear", "strain rate II component", "1/s" "shlat", "southern latitude of artificial mask edge", "30\ :math:`^\circ`\ N" @@ -596,12 +602,11 @@ either Celsius or Kelvin units). "tarear", "1/tarea", "1/m\ :math:`^2`" "tareas", "area of southern hemisphere T-cells", "m\ :math:`^2`" "tcstr", "string identifying T grid for history variables", "" - "tday", "absolute day number", "" "Tf", "freezing temperature", "C" "Tffresh", "freezing temp of fresh ice", "273.15 K" "tfrz_option", ":math:`\bullet` form of ocean freezing temperature", "" "thinS", "minimum ice thickness for brine tracer", "" - "time", "total elapsed time", "s" + "timesecs", "total elapsed time in seconds", "s" "time_beg", "beginning time for history averages", "" "time_bounds", "beginning and ending time for history averages", "" "time_end", "ending time for history averages", "" @@ -681,7 +686,7 @@ either Celsius or Kelvin units). "**X**", "", "" "**Y**", "", "" "ycycle", ":math:`\bullet` number of years in forcing data cycle", "" - "yday", "day of the year", "" + "yday", "day of the year, computed in the model calendar", "" "yield_curve", "type of yield curve", "ellipse" "yieldstress11(12, 22)", "yield stress tensor components", "" "year_init", ":math:`\bullet` the initial year", "" diff --git a/doc/source/conf.py b/doc/source/conf.py index e876980ab..4cf2f580d 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'6.1.4' +version = u'6.2.0' # The full version, including alpha/beta/rc tags. -version = u'6.1.4' +version = u'6.2.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/developer_guide/dg_dynamics.rst b/doc/source/developer_guide/dg_dynamics.rst index c94d47b35..47b54bde2 100644 --- a/doc/source/developer_guide/dg_dynamics.rst +++ b/doc/source/developer_guide/dg_dynamics.rst @@ -90,12 +90,9 @@ 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 and tends to look like this:: +place in the **CICE_RunMod.F90** file which is part of the driver code. - call ice_step - istep = istep + 1 ! update time step counters - istep1 = istep1 + 1 - time = time + dt ! determine the time and date +The time manager was updated in early 2021. Additional information about the time manager can be found here, :ref:`timemanagerplus` diff --git a/doc/source/developer_guide/dg_forcing.rst b/doc/source/developer_guide/dg_forcing.rst index 90ef843b0..0c0380538 100644 --- a/doc/source/developer_guide/dg_forcing.rst +++ b/doc/source/developer_guide/dg_forcing.rst @@ -120,8 +120,8 @@ Time interpolation coefficients are computed in the **JRA55_data** subroutine. The forcing data is converted to model inputs in the subroutine **prepare_forcing** called in **get_forcing_atmo**. To clarify, the JRA55 input data includes -- uatm = model grid i-direction wind velocity component (m/s) -- vatm = model grid j-direction wind velocity component (m/s) +- uatm = T-cell centered, model grid i-direction wind velocity component (m/s) +- vatm = T-cell-centered, model grid j-direction wind velocity component (m/s) - Tair = air temperature (K) - Qa = specific humidity (kg/kg) - flw = incoming longwave radiation (W/m^2) diff --git a/doc/source/developer_guide/dg_scripts.rst b/doc/source/developer_guide/dg_scripts.rst index da5ef7d24..50853b3ea 100644 --- a/doc/source/developer_guide/dg_scripts.rst +++ b/doc/source/developer_guide/dg_scripts.rst @@ -161,25 +161,25 @@ To add a new test (for example newtest), several files may be needed, Generating a new test, particularly the **test_newtest.script** usually takes some iteration before it's working properly. -.. _dev_compliance: +.. _dev_validation: -Code Compliance Script +Code Validation Script ---------------------- -The code compliance test validates non bit-for-bit model changes. The directory -**configuration/scripts/tests/QC** contains scripts related to the compliance testing, -and this process is described in :ref:`compliance`. This section will describe a set -of scripts that test and validate the code compliance process. This should be done -when the compliance test or compliance test scripts (i.e., ``cice.t-test.py``) are modified. -Again, this section **documents a validation process for the compliance scripts**; it does not -describe to how run the compliance test itself. +The code validation (aka QC or quality control) test validates non bit-for-bit model changes. The directory +**configuration/scripts/tests/QC** contains scripts related to the validation testing, +and this process is described in :ref:`validation`. This section will describe a set +of scripts that test and validate the QC process. This should be done +when the QC test or QC test scripts (i.e., ``cice.t-test.py``) are modified. +Again, this section **documents a validation process for the QC scripts**; it does not +describe to how run the validation test itself. -Two scripts have been created to automatically validate the code compliance script. +Two scripts have been created to automatically validate the QC script. These scripts are: * ``gen_qc_cases.csh``, which creates the 4 test cases required for validation, builds the executable, and submits to the queue. -* ``compare_qc_cases.csh``, which runs the code compliance script on three combinations +* ``compare_qc_cases.csh``, which runs the QC script on three combinations of the 4 test cases and outputs whether or not the correct response was received. The ``gen_qc_cases.csh`` script allows users to pass some arguments similar @@ -216,7 +216,7 @@ To install the necessary Python packages, the ``pip`` Python utility can be used check to see if there is any Python module (``module avail python``) that you might need to load prior to using ``pip``. -To perform the validation, execute the following commands. +To perform the QC validation, execute the following commands. .. code-block:: bash diff --git a/doc/source/developer_guide/dg_tools.rst b/doc/source/developer_guide/dg_tools.rst new file mode 100644 index 000000000..ba29e0184 --- /dev/null +++ b/doc/source/developer_guide/dg_tools.rst @@ -0,0 +1,150 @@ +:tocdepth: 3 + +.. _tools: + +Tools +============= + + +.. _cice4restart: + +CICE4 restart conversion +------------------------- + +There is a Fortran program in **configuration/tools/cice4_restart_conversion** +that will help convert a CICE4 restart file into a CICE5 restart file. +There is a bit of documentation contained in that source code about how +to build, use, and run the tool. A few prognostic variables were changed +from CICE4 to CICE5 which fundamentally altered the fields saved to +the restart file. See +**configuration/tools/cice4_restart_conversion/convert_restarts.f90** +for additional information. + + +.. _jra55datasettool: + +JRA55 forcing datasets +------------------------ + +This section describes how to generate JRA55 forcing data for the CICE model. +Raw JRA55 files have to be interpolated and processed into input files specifically +for the CICE model. A tool exists in **configuration/tools/jra55_datasets** +to support that process. +The raw JRA55 data is obtained from the NCAR/UCAR Research Data Archive and +the conversion tools are written in python. + +Requirements +********************* + +Python3 is required, and the following +python packages are required with the tested version number in parenthesis. These +versions are not necessarily the only versions that work, they just indicate what +versions were used when the script was recently run. + +- python3 (python3.7.9) +- numpy (1.18.5) +- netCDF4 (1.5.5) +- ESMPy (8.0.0) +- xesmf (0.3.0) + +NCO is required for aggregating the output files into yearly files. + +- netcdf (4.7.4) +- nco (4.9.5) + +Raw JRA55 forcing data +************************* + +The raw JRA55 forcing data is obtained from the UCAR/NCAR Research Data Archive, +https://rda.ucar.edu/. You must first register (free) and then sign in. The +"JRA-55 Reanalysis Daily 3-Hourly and 6-Hourly Data" is ds628.0 and can be found here, +https://rda.ucar.edu/datasets/ds628.0. + +The "Data access" tabs will provide a list of product categories. +The JRA55 data of interest are located in 2 separate products. Winds, air +temperature, and specific humidity fields are included in "JRA-55 +3-Hourly Model Resolution 2-Dimensional Instantaneous Diagnostic Fields". +Precipitation and downward radiation fluxes are found in "JRA-55 3-Hourly +Model Resolution 2-Dimensional Average Diagnostic Fields". (Note the +difference between instantaneous and averaged data products. There are several +JRA55 datasets available, you will likely have to scroll down the page to find +these datasets.) Data are also available on a coarser 1.25° grid, but the tools +are best used with the native TL319 JRA55 grid. + +The fields needed for CICE are + +- specific humidity (3-hourly instantaneous), Qa +- temperature (3-hourly instantaneous), Tair +- u-component of wind (3-hourly instantaneous), uatm +- v-component of wind(3-hourly instantaneous), vatm +- downward longwave radiation flux (3 hourly average), flw +- downward solar radiation flux (3 hourly average), fsw +- total precipitation (3 hourly average), fsnow + +To customize the dataset for download, choose the “Get a Subset” option. Select +the desired times in the “Temporal Selection” section, then click on desired parameters +(see list above). After clicking continue, select Output Format "Converted to NetCDF". + +Once the data request is made, an email notification will be sent with a dedicated +URL that will provide a variety of options for downloading the data remotely. +The data will be available to download for 5 days. +The raw data consists of multiple files, each containing three months of data for +one field. + + +Data conversion +************************* + +The script, **configuration/tools/jra55_datasets/interp_jra55_ncdf_bilinear.py**, +converts the raw data to CICE input files. + +The script uses a bilinear regridding algorithm to regrid from the JRA55 grid to +the CICE grid. The scripts use the Python package ‘xesmf’ to generate bilinear +regridding weights, and these regridding weights are written to the file defined by +the variable "blin_grid_name" in **interp_jra55_ncdf_bilinear.py**. This filename +can be modified by editing **interp_jra55_ncdf_bilinear.py**. +The weights file can be re-used if interpolating different data on the same grid. +Although not tested in this version of the scripts, additional regridding options +are available by xesmf, including ‘conservative’ and ‘nearest neighbor’. These +methods have not been tested in the current version of the scripts. The reader +is referred to the xESMF web page for further documentation +(https://xesmf.readthedocs.io/en/latest/ last accessed 5 NOV 2020). + +To use the **interp_jra55_ncdf_bilinear** script, do :: + + python3 interp_jra55_ncdf_bilinear.py –h + +to see the latest interface information :: + + usage: interp_jra55_ncdf_bilinear.py [-h] JRADTG gridout ncout + + Interpolate JRA55 data to CICE grid + + positional arguments: + JRADTG JRA55 input file date time group + gridout CICE grid file (NetCDF) + ncout Output NetCDF filename + + optional arguments: + -h, --help show this help message and exit + +Sample usage is :: + + ./interp_jra55_ncdf_bilinear.py 1996010100_1996033121 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q1.nc + ./interp_jra55_ncdf_bilinear.py 1996040100_1996063021 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q2.nc + ./interp_jra55_ncdf_bilinear.py 1996070100_1996093021 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q3.nc + ./interp_jra55_ncdf_bilinear.py 1996100100_1996123121 grid_gx3.nc JRA55_gx3_03hr_forcing_1996-q4.nc + +In this case, the 4 quarters of 1996 JRA55 data is going to be interpolated to the gx3 grid. +NCO can be used to aggregate these files into a single file :: + + ncrcat JRA55_gx3_03hr_forcing_1996-??.nc JRA55_${grid}_03hr_forcing_1996.nc + +NOTES + +- The scripts are designed to read a CICE grid file in netCDF format. This is the "grid_gx3.nc" file above. The NetCDF grid names are hardcoded in **interp_jra55_ncdf_bilinear.py**. If you are using a different grid file with different variable names, this subroutine needs to be updated. +- All files should be placed in a common directory. This includes the raw JRA55 input files, the CICE grid file, and **interp_jra55_ncdf_bilinear.py**. The output files will be written to the same directory. +- The script **configuration/tools/jra55_datasets/make_forcing.csh** was used on the NCAR cheyenne machine in March, 2021 to generate CICE forcing data. It assumes the raw JRA55 is downloaded, but then sets up the python environment, links all the data in a common directory, runs **interp_jra55_ncdf_bilinear.py** and then aggregates the quarterly data using NCO. +- The new forcing files can then be defined in the **ice_in** namelist file using the input variables, ``atm_data_type``, ``atm_data_format``, ``atm_data_dir``, ``fyear_init``, and ``ycycle``. See :ref:`forcing` for more information. +- The total precipitation field is mm/day in JRA55. This field is initially read in as snow, but prepare_forcing in **ice_forcing.F90** splits that into rain or snow forcing depending on the air temperature. + diff --git a/doc/source/developer_guide/index.rst b/doc/source/developer_guide/index.rst index ab5b2d1e6..6fc3356f4 100644 --- a/doc/source/developer_guide/index.rst +++ b/doc/source/developer_guide/index.rst @@ -17,5 +17,6 @@ Developer Guide dg_forcing.rst dg_icepack.rst dg_scripts.rst + dg_tools.rst dg_other.rst diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index ccf7f0356..44ee6f5b0 100644 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -78,6 +78,7 @@ can be modified as needed. "ICE_HSTDIR", "string", "unused", "${ICE_RUNDIR}/history" "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" "ICE_DRVOPT", "string", "unused", "standalone/cice" + "ICE_TARGET", "string", "build target", "set by cice.setup" "ICE_IOTYPE", "string", "I/O format", "set by cice.setup" " ", "netcdf", "serial netCDF" " ", "pio", "parallel netCDF" @@ -143,7 +144,9 @@ setup_nml "``conserv_check``", "logical", "check conservation", "``.false.``" "``cpl_bgc``", "logical", "couple bgc thru driver", "``.false.``" "``days_per_year``", "integer", "number of days in a model year", "365" - "``dbug``", "logical", "write extra diagnostics", "``.false.``" + "``day_init``", "integer", "the initial day of the month if not using restart", "1" + "``debug_model``", "logical", "write extended model point diagnostics", "``.false.``" + "``debug_model_step``", "logical", "initial timestep to write ``debug_model`` output", "999999999" "``diagfreq``", "integer", "frequency of diagnostic output in timesteps", "24" "``diag_type``", "``stdout``", "write diagnostic output to stdout", "``stdout``" "", "``file``", "write diagnostic output to file", "" @@ -156,6 +159,7 @@ setup_nml "", "``1``", "write restart every ``dumpfreq_n`` time step", "" "``dumpfreq_n``", "integer", "write restart frequency with ``dumpfreq``", "1" "``dump_last``", "logical", "write restart on last time step of simulation", "``.false.``" + "``forcing_diag``", "logical", "write extra diagnostics", "``.false.``" "``hist_avg``", "logical", "write time-averaged data", "``.true.``" "``histfreq``", "``d``", "write history every ``histfreq_n`` days", "'1','h','d','m','y'" "", "``h``", "write history every ``histfreq_n`` hours", "" @@ -178,8 +182,15 @@ setup_nml "``latpnt``", "real", "latitude of (2) diagnostic points", "90.0,-65.0" "``lcdf64``", "logical", "use 64-bit netcdf format", "``.false.``" "``lonpnt``", "real", "longitude of (2) diagnostic points", "0.0,-45.0" + "``month_init``", "integer", "the initial month if not using restart", "1" "``ndtd``", "integer", "number of dynamics/advection/ridging/steps per thermo timestep", "1" - "``npt``", "integer", "total number of time steps to take", "99999" + "``npt``", "integer", "total number of npt_units to run the model", "99999" + "``npt_unit``", "``d``", "run ``npt`` days", "1" + "", "``h``", "run ``npt`` hours", "" + "", "``m``", "run ``npt`` months", "" + "", "``s``", "run ``npt`` seconds", "" + "", "``y``", "run ``npt`` years", "" + "", "``1``", "run ``npt`` timesteps", "" "``numin``", "integer", "minimum internal IO unit number", "11" "``numax``", "integer", "maximum internal IO unit number", "99" "``pointer_file``", "string", "restart pointer filename", "'ice.restart_file'" @@ -194,6 +205,7 @@ setup_nml "``runid``", "string", "label for run (currently CESM only)", "'unknown'" "``runtype``", "``continue``", "restart using ``pointer_file``", "``initial``" "", "``initial``", "start from ``ice_ic``", "" + "``sec_init``", "integer", "the initial second if not using restart", "0" "``use_leap_years``", "logical", "include leap days", "``.false.``" "``use_restart_time``", "logical", "set initial date using restart file", "``.true.``" "``version_name``", "string", "model version", "'unknown_version_name'" @@ -212,6 +224,7 @@ grid_nml "``bathymetry_file``", "string", "name of bathymetry file to be read", "‘unknown_bathymetry_file’" "``bathymetry_format``", "``default``", "NetCDF depth field", "‘default’" "", "``pop``", "pop thickness file in cm in ascii format", "" + "``close_boundaries``", "logical", "force two gridcell wide land mask on boundaries", "``.false.`` "``dxrect``", "real", "x-direction grid spacing for rectangular grid in cm", "0.0" "``dyrect``", "real", "y-direction grid spacing for rectangular grid in cm", "0.0" "``gridcpl_file``", "string", "input file for coupling grid info", "'unknown_gridcpl_file'" @@ -248,6 +261,7 @@ domain_nml "``add_mpi_barriers``", "logical", "throttle communication", "``.false.``" "``block_size_x``", "integer", "block size in x direction", "-1" "``block_size_y``", "integer", "block size in y direction", "-1" + "``debug_blocks``", "logical", "add additional print statements to debug the block decomposition", "``.false.``" "``distribution_type``", "``cartesian``", "2D cartesian block distribution method", "``cartesian``" "", "``rake``", "redistribute blocks among neighbors", "" "", "``roundrobin``", "1 block per proc until blocks are used", "" @@ -355,6 +369,8 @@ dynamics_nml "", "", "", "" "``advection``", "``remap``", "linear remapping advection scheme", "``remap``" "", "``upwind``", "donor cell advection", "" + "``algo_nonlin``", "``anderson``", "use nonlinear anderson algorithm for implicit solver", "picard" + "", "``picard``", "use picard algorithm", "" "``alphab``", "real", ":math:`\alpha_{b}` factor in :cite:`Lemieux16`", "20.0" "``arlx``", "real", "revised_evp value", "300.0" "``brlx``", "real", "revised_evp value", "300.0" @@ -394,11 +410,11 @@ dynamics_nml "``monitor_pgmres``", "logical", "write velocity norm at each PGMRES iteration", "``.false.``" "``mu_rdg``", "real", "e-folding scale of ridged ice for ``krdg_partic`` = 1 in m^0.5", "3.0" "``ndte``", "integer", "number of EVP subcycles", "120" - "``ortho_type``", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "``mgs``" - "", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "" - "``precond``", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "``pgmres``" - "", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "" + "``ortho_type``", "``cgs``", "Use classical Gram-Shchmidt in FGMRES solver", "``mgs``" + "", "``mgs``", "Use modified Gram-Shchmidt in FGMRES solver", "" + "``precond``", "``diag``", "Use Jacobi preconditioner for the FGMRES solver", "``pgmres``" "", "``ident``", "Don't use a preconditioner for the FGMRES solver", "" + "", "``pgmres``", "Use GMRES as preconditioner for FGMRES solver", "" "``Pstar``", "real", "constant in Hibler strength formula (N/m\ :math:`^2`)", "2.75e4" "``reltol_nonlin``", "real", "relative tolerance for nonlinear solver", "1e-8" "``reltol_fgmres``", "real", "relative tolerance for FGMRES solver", "1e-2" @@ -411,6 +427,7 @@ dynamics_nml "", "``geostropic``", "computed from ocean velocity", "" "``threshold_hw``", "real", "Max water depth for grounding (see :cite:`Amundrud04`)", "30." "``yield_curve``", "``ellipse``", "elliptical yield curve", "``ellipse``" + "``use_mean_vrel``", "logical", "Use mean of two previous iterations for vrel in VP", "``.true.``" "", "", "", "" shortwave_nml @@ -495,7 +512,7 @@ forcing_nml "``default_season``", "``summer``", "forcing initial summer values", "``winter``" "", "``winter``", "forcing initial winter values", "" "``emissivity``", "real", "emissivity of snow and ice", "0.985" - "``fbot_xfer_type``", "``Cdn_ocn``", "variabler ocean heat transfer coefficient scheme", "``constant``" + "``fbot_xfer_type``", "``Cdn_ocn``", "variable ocean heat transfer coefficient scheme", "``constant``" "", "``constant``", "constant ocean heat transfer coefficient", "" "``fe_data_type``", "``clim``", "ocean climatology forcing value for iron", "``default``" "", "``default``", "default forcing value for iron", "" @@ -505,6 +522,7 @@ forcing_nml "``ice_data_type``", "``boxslotcyl``", "initialize ice concentration and velocity for :ref:`boxslotcyl` test (:cite:`Zalesak79`)", "``default``" "", "``box2001``", "initialize ice concentration for :ref:`box2001` test (:cite:`Hunke01`)", "" "", "``default``", "no special initialization", "" + "``iceruf``", "real", "ice surface roughness at atmosphere interface", "0.0005" "``l_mpond_fresh``", "``.false.``", "release pond water immediately to ocean", "``.false.``" "", "``true``", "retain (topo) pond water until ponds drain", "" "``natmiter``", "integer", "number of atmo boundary layer iterations", "5" @@ -525,6 +543,7 @@ forcing_nml "``restart_coszen``", "logical", "read/write coszen in restart files", "``.false.``" "``restore_ocn``", "logical", "restore sst to data", "``.false.``" "``restore_ice``", "logical", "restore ice state along lateral boundaries", "``.false.``" + "``rotate_wind``", "logical", "rotate wind from east/north to computation grid", "``.true.``" "``tfrz_option``", "``linear_salt``", "linear functino of salinity (ktherm=1)", "``mushy``" "", "``minus1p8``", "constant ocean freezing temperature (:math:`-1.8^{\circ} C`)", "" "", "``mushy``", "matches mushy-layer thermo (ktherm=2)", "" diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index cbfe37b0c..566d10fbc 100644 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -163,18 +163,19 @@ information to the log file, and if the block size or max blocks is inconsistent with the task and thread size, the model will abort. The code will also print a warning if the maximum number of blocks is too large. Although this is not fatal, it does use extra memory. If ``max_blocks`` is -set to -1, the code will compute a ``max_blocks`` on the fly. +set to -1, the code will compute a tentative ``max_blocks`` on the fly. A loop at the end of routine *create\_blocks* in module **ice\_blocks.F90** will print the locations for all of the blocks on -the global grid if dbug is set to be true. Likewise, a similar loop at +the global grid if the namelist variable ``debug_blocks`` is set to be true. Likewise, a similar loop at the end of routine *create\_local\_block\_ids* in module **ice\_distribution.F90** will print the processor and local block number for each block. With this information, the grid decomposition -into processors and blocks can be ascertained. The dbug flag must be -manually set in the code in each case (independently of the dbug flag in -**ice\_in**), as there may be hundreds or thousands of blocks to print -and this information should be needed only rarely. This information is +into processors and blocks can be ascertained. This ``debug_blocks`` variable +should be used carefully as there may be hundreds or thousands of blocks to print +and this information should be needed only rarely. ``debug_blocks`` +can be set to true using the +``debugblocks`` option with **cice.setup**. This information is much easier to look at using a debugger such as Totalview. There is also an output field that can be activated in `icefields\_nml`, ``f_blkmask``, that prints out the variable ``blkmask`` to the history file and @@ -268,8 +269,11 @@ routines, is adopted from POP. The boundary routines perform boundary communications among processors when MPI is in use and among blocks whenever there is more than one block per processor. -Open/cyclic boundary conditions are the default in CICE; the physical -domain can still be closed using the land mask. In our bipolar, +Open/cyclic boundary conditions are the default in CICE. Closed boundary +conditions are not supported currently. The physical +domain can still be closed using the land mask and this can be done in +namelist with the ``close_boundaries`` namelist which forces the mask +on the boundary to land for a two gridcell depth. In our bipolar, displaced-pole grids, one row of grid cells along the north and south boundaries is located on land, and along east/west domain boundaries not masked by land, periodic conditions wrap the domain around the globe. @@ -529,12 +533,72 @@ schemes and the aerosol tracers, and the level-ice pond parameterization additionally requires the level-ice tracers. +.. _timemanagerplus: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Time Manager and Initialization +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The time manager is an important piece of the CICE model. + +.. _timemanager: + +**************************** +Time Manager +**************************** + +The primary prognostic variables in the time manager are ``myear``, +``mmonth``, ``mday``, and ``msec``. These are integers and identify +the current model year, month, day, and second respectively. +The model timestep is ``dt`` with units of seconds. See :ref:`parameters` +for additional information about choosing an appropriate timestep. +The internal variables ``istep``, ``istep0``, and ``istep1`` keep +track of the number of timesteps. ``istep`` is the counter for +the current run and is set to 0 at the start of each run. ``istep0`` +is the step count at the start of a long multi-restart run, and +``istep1`` is the step count of a long multi-restart run. + +In general, the time manager should be advanced by calling +*advance\_timestep*. This subroutine in **ice\_calendar.F90** +automatically advances the model time by ``dt``. It also advances +the istep numbers and calls subroutine *calendar* to update +additional calendar data. + +The namelist variable ``use_restart_time`` specifies whether to +use the time and step numbers saved on a restart file or whether +to set the initial model time to the namelist values defined by +``year_init``, ``month_init``, ``day_init``, and ``sec_init``. +Normally, ``use_restart_time`` is set to false on the initial run +and then set to true on subsequent restart runs of the same +case to allow time to advance thereafter. More information about +the restart capability can be found here, :ref:`restartfiles`. + +The time manager was updated in early 2021. The standalone model +was modified, and some tests were done in a coupled framework after +modifications to the high level coupling interface. For some coupled models, the +coupling interface may need to be updated when updating CICE with the new time manager. +In particular, the old prognostic variable ``time`` no longer exists in CICE, +``year_init`` only defines the model initial year, and +the calendar subroutine is called without any arguments. One can +set the namelist variables ``year_init``, ``month_init``, ``day_init``, +``sec_init``, and ``dt`` in conjuction with ``days_per_year`` and +``use_leap_years`` to initialize the model date, timestep, and calendar. +To overwrite the default/namelist settings in the coupling layer, +set the **ice\_calendar.F90** variables ``myear``, ``mmonth``, ``mday``, +``msec`` and ``dt`` after the namelists have been read. Subroutine +*calendar* should then be called to update all the calendar data. +Finally, subroutine *advance\_timestep* should be used to advance +the model time manager. It advances the step numbers, advances +time by ``dt``, and updates the calendar data. The older method +of manually advancing the steps and adding ``dt`` to ``time`` should +be deprecated. + .. _init: -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Initialization and coupling -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +**************************** +Initialization and Restarts +**************************** The ice model’s parameters and variables are initialized in several steps. Many constants and physical parameters are set in @@ -612,9 +676,9 @@ reset to ‘none.’ .. _parameters: -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +********************************** Choosing an appropriate time step -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +********************************** The time step is chosen based on stability of the transport component (both horizontal and in thickness space) and on resolution of the @@ -705,6 +769,8 @@ the problem, and ``brlx`` represents the effective subcycling Model output ~~~~~~~~~~~~ +There are a number of model output streams and formats. + .. _history: ************* @@ -720,7 +786,8 @@ for history and restart files, and history and restart file must use the same io package. The namelist variable ``history_format`` further refines the format approach or style for some io packages. -Model output data is averaged over the period(s) given by ``histfreq`` and +Model output data can be written as instantaneous or average data as specified +by the ``hist_avg`` namelist flag. The data is written at the period(s) given by ``histfreq`` and ``histfreq_n``, and written to binary or netCDF files prepended by ``history_file`` in **ice_in**. These settings for history files are set in the **setup_nml** section of **ice_in** (see :ref:`tabnamelist`). @@ -759,20 +826,22 @@ is now a character string corresponding to ``histfreq`` or ‘x’ for none. files, no matter what the frequency is.) If there are no namelist flags with a given ``histfreq`` value, or if an element of ``histfreq_n`` is 0, then no file will be written at that frequency. The output period can be -discerned from the filenames. +discerned from the filenames. All history streams will be either instantaneous +or averaged as specified by the ``hist_avg`` namelist setting. For example, in the namelist: :: - ``histfreq`` = ’1’, ’h’, ’d’, ’m’, ’y’ - ``histfreq_n`` = 1, 6, 0, 1, 1 - ``f_hi`` = ’1’ - ``f_hs`` = ’h’ - ``f_Tsfc`` = ’d’ - ``f_aice`` = ’m’ - ``f_meltb`` = ’mh’ - ``f_iage`` = ’x’ + histfreq = ’1’, ’h’, ’d’, ’m’, ’y’ + histfreq_n = 1, 6, 0, 1, 1 + hist_avg = .true. + f_hi = ’1’ + f_hs = ’h’ + f_Tsfc = ’d’ + f_aice = ’m’ + f_meltb = ’mh’ + f_iage = ’x’ Here, ``hi`` will be written to a file on every timestep, ``hs`` will be written once every 6 hours, ``aice`` once a month, ``meltb`` once a month AND @@ -784,6 +853,14 @@ as long as for a single frequency. If you only want monthly output, the most efficient setting is ``histfreq`` = ’m’,’x’,’x’,’x’,’x’. The code counts the number of desired streams (``nstreams``) based on ``histfreq``. +There is no restart capability built into the history implementation. If the +model stops in the middle of a history accumulation period, that data is lost +on restart, and the accumulation is zeroed out at startup. That means the +dump frequency (see :ref:`restartfiles`) and history frequency need to be +somewhat coordinated. For +example, if monthly history files are requested, the dump frequency should be +set to an integer number of months. + The history variable names must be unique for netCDF, so in cases where a variable is written at more than one frequency, the variable name is appended with the frequency in files after the first one. In the example @@ -799,7 +876,7 @@ every 3 months, for example. If ``write_ic`` is set to true in **ice\_in**, a snapshot of the same set of history fields at the start of the run will be written to the history directory in **iceh\_ic.[timeID].nc(da)**. Several history variables are -hard-coded for instantaneous output regardless of the averaging flag, at +hard-coded for instantaneous output regardless of the ``hist_avg`` averaging flag, at the frequency given by their namelist flag. The normalized principal components of internal ice stress are computed @@ -908,6 +985,8 @@ The timers use *MPI\_WTIME* for parallel runs and the F90 intrinsic | 16 | BGC | biogeochemistry | +--------------+-------------+----------------------------------------------------+ +.. _restartfiles: + ************* Restart files ************* @@ -937,7 +1016,8 @@ Additional namelist flags provide further control of restart behavior. of a run when it is otherwise not scheduled to occur. The flag ``use_restart_time`` enables the user to choose to use the model date provided in the restart files. If ``use_restart_time`` = false then the -initial model date stamp is determined from the namelist parameters. +initial model date stamp is determined from the namelist parameters, +``year_init``, ``month_init``, ``day_init``, and ``sec_init``.. lcdf64 = true sets 64-bit netCDF output, allowing larger file sizes. Routines for gathering, scattering and (unformatted) reading and writing @@ -957,5 +1037,6 @@ initialized with no ice. The gx3 case was run for 1 year using the 1997 forcing data provided with the code. The gx1 case was run for 20 years, so that the date of restart in the file is 1978-01-01. Note that the restart dates provided in the restart files can be overridden using the -namelist variables ``use_restart_time``, ``year_init`` and ``istep0``. The +namelist variables ``use_restart_time``, ``year_init``, ``month_init``, +``day_init``, and ``sec_init``. The forcing time can also be overridden using ``fyear_init``. diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 541fa81a4..aca7d4933 100644 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -36,12 +36,19 @@ The Consortium has tested the following compilers at some point, - Intel 17.0.2.174 - Intel 17.0.5.239 - Intel 18.0.1.163 +- Intel 18.0.5 - Intel 19.0.2 - Intel 19.0.3.199 +- Intel 19.1.0.166 +- Intel 19.1.1.217 - PGI 16.10.0 +- PGI 19.9-0 +- PGI 20.1-0 - GNU 6.3.0 - GNU 7.2.0 - GNU 7.3.0 +- GNU 8.3.0 +- GNU 9.3.0 - Cray 8.5.8 - Cray 8.6.4 - NAG 6.2 @@ -54,22 +61,33 @@ The Consortium has tested the following mpi versions, - MPICH 7.6.3 - MPICH 7.7.6 - Intel MPI 18.0.1 +- Intel MPI 18.0.4 +- Intel MPI 2019 Update 6 - MPT 2.14 - MPT 2.17 - MPT 2.18 - MPT 2.19 +- MPT 2.20 +- MPT 2.21 +- mvapich2-2.3.3 - OpenMPI 1.6.5 +- OpenMPI 4.0.2 The NetCDF implementation is relatively general and should work with any version of NetCDF 3 or 4. The Consortium has tested - NetCDF 4.3.0 - NetCDF 4.3.2 - NetCDF 4.4.0 -- NetCDF 4.4.1.1.32 +- NetCDF 4.4.1.1.3 - NetCDF 4.4.1.1 - NetCDF 4.4.2 - NetCDF 4.5.0 +- NetCDF 4.5.2 - NetCDF 4.6.1.3 +- NetCDF 4.6.3 +- NetCDF 4.6.3.2 +- NetCDF 4.7.2 +- NetCDF 4.7.4 Please email the Consortium if this list can be extended. @@ -257,7 +275,7 @@ Some of the options are ``bgcISPOL`` and ``bgcNICE`` specify bgc options -``boxadv``, ``boxdyn``, and ``boxrestore`` are simple box configurations +``boxadv``, ``boxnodyn``, and ``boxrestore`` are simple box configurations ``alt*`` which turns on various combinations of dynamics and physics options for testing @@ -713,7 +731,14 @@ Next, create the "cice" conda environment from the ``environment.yml`` file in t conda env create -f configuration/scripts/machines/environment.yml -This step needs to be done only once. +This step needs to be done only once and will maintain a static conda environment. To update the conda environment later, use + +.. code-block:: bash + + conda env create -f configuration/scripts/machines/environment.yml --force + +This will update the conda environment to the latest software versions. + .. _using_conda_env: @@ -772,7 +797,7 @@ A few notes about the conda configuration: - It is not recommeded to run other test suites than ``quick_suite`` or ``travis_suite`` on a personal computer. - The conda environment is automatically activated when compiling or running the model using the ``./cice.build`` and ``./cice.run`` scripts in the case directory. These scripts source the file ``env.conda_{linux.macos}``, which calls ``conda activate cice``. -- To use the "cice" conda environment with the Python plotting (see :ref:`timeseries`) and quality control scripts (see :ref:`CodeCompliance`), you must manually activate the environment: +- To use the "cice" conda environment with the Python plotting (see :ref:`timeseries`) and quality control (QC) scripts (see :ref:`CodeValidation`), you must manually activate the environment: .. code-block:: bash @@ -897,7 +922,7 @@ To use the ``timeseries.py`` script, the following requirements must be met: * matplotlib Python package * datetime Python package -See :ref:`CodeCompliance` for additional information about how to setup the Python +See :ref:`CodeValidation` for additional information about how to setup the Python environment, but we recommend using ``pip`` as follows: :: pip install --user numpy diff --git a/doc/source/user_guide/ug_testing.rst b/doc/source/user_guide/ug_testing.rst index 61aa1c05f..5a289db6a 100644 --- a/doc/source/user_guide/ug_testing.rst +++ b/doc/source/user_guide/ug_testing.rst @@ -525,7 +525,7 @@ Test Suite Examples This will compare to results saved in the baseline [bdir] directory under the subdirectory cice.v01a. With the ``--bcmp`` option, the results will be tested against prior baselines to verify bit-for-bit, which is an important step prior - to approval of many (not all, see :ref:`compliance`) Pull Requests to incorporate code into + to approval of many (not all, see :ref:`validation`) Pull Requests to incorporate code into the CICE Consortium master code. You can use other regression options as well. (``--bdir`` and ``--bgen``) @@ -625,6 +625,49 @@ Test Suite Examples The setenv syntax is for csh/tcsh. In bash, the syntax would be SUITE_BUILD=true. +.. _unittesting: + +Unit Testing +--------------- + +Unit testing is supported in the CICE scripts. Unit tests are implemented +via a distinct top level driver that tests CICE model features explicitly. +These drivers can be found in **cicecore/drivers/unittest/**. In addition, +there are some script files that also support the unit testing. + +The unit tests build and run very much like the standard CICE model. +A case is created and model output is saved to the case logs directory. +Unit tests can be run as part of a test suite and the output is +compared against an earlier set of output using a simple diff of the +log files. + +For example, to run the existing calendar unit test as a case, + +.. code-block:: bash + + ./cice.setup -m onyx -e intel --case calchk01 -p 1x1 -s calchk + cd calchk01 + ./cice.build + ./cice.submit + +Or to run the existing calendar unit test as a test, + +.. code-block:: bash + + ./cice.setup -m onyx -e intel --test unittest -p 1x1 --testid cc01 -s calchk --bgen cice.cc01 + cd onyx_intel_unittest_gx3_1x1_calchk.cc01/ + ./cice.build + ./cice.submit + +To create a new unit test, add a new driver in **cicecore/driver/unittest**. +The directory name should be the name of the test. +Then create the appropriate set_nml or set_env files for the new unittest name +in **configuration/scripts/options**. In particular, **ICE_DRVOPT** and +**ICE_TARGET** need to be defined in a set_env file. Finally, edit +**configuration/scripts/Makefile** and create a target for the unit test. +The unit tests calchk or helloworld can be used as examples. + + .. _testreporting: Test Reporting @@ -672,7 +715,10 @@ This argument turns on special compiler flags including reduced optimization and invokes the gcov tool. Once runs are complete, either lcov or codecov can be used to analyze the results. This option is currently only available with the gnu compiler and on a few systems -with modified Macros files. +with modified Macros files. In the current implementation, when ``--coverage`` is +invoked, the sandbox is copied to a new sandbox called something like cice_lcov_yymmdd-hhmmss. +The source code in the new sandbox is modified slightly to improve coverage statistics +and the full coverage suite is run there. At the present time, the ``--coverage`` flag invokes the lcov analysis automatically by running the **report_lcov.csh** script in the test suite directory. The output @@ -728,9 +774,9 @@ assess test coverage. ..in the future. -.. _compliance: +.. _validation: -Code Compliance Test (non bit-for-bit validation) +Code Validation Test (non bit-for-bit validation) ---------------------------------------------------- A core tenet of CICE dycore and CICE innovations is that they must not change @@ -855,7 +901,7 @@ autocorrelation :math:`r_1`. .. _quadratic: -Quadratic Skill Compliance Test +Quadratic Skill Validation Test ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In addition to the two-stage test of mean sea ice thickness, we also @@ -939,12 +985,12 @@ hemispheres, and must exceed a critical value nominally set to test and the Two-Stage test described in the previous section are provided in :cite:`Hunke18`. -.. _CodeCompliance: +.. _CodeValidation: -Code Compliance Testing Procedure +Code Validation Testing Procedure ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The CICE code compliance test is performed by running a python script +The CICE code validation (QC) test is performed by running a python script (**configurations/scripts/tests/QC/cice.t-test.py**). In order to run the script, the following requirements must be met: @@ -958,7 +1004,7 @@ QC testing should be carried out using configurations (ie. namelist settings) th exercise the active code modifications. Multiple configurations may need to be tested in some cases. Developers can contact the Consortium for guidance or if there are questions. -In order to generate the files necessary for the compliance test, test cases should be +In order to generate the files necessary for the validation test, test cases should be created with the ``qc`` option (i.e., ``--set qc``) when running cice.setup. This option results in daily, non-averaged history files being written for a 5 year simulation. @@ -970,7 +1016,7 @@ To install the necessary Python packages, the ``pip`` Python utility can be used pip install --user numpy pip install --user matplotlib -To run the compliance test, setup a baseline run with the original baseline model and then +To run the validation test, setup a baseline run with the original baseline model and then a perturbation run based on recent model changes. Use ``--set qc`` in both runs in addition to other settings needed. Then use the QC script to compare history output, diff --git a/doc/source/user_guide/ug_troubleshooting.rst b/doc/source/user_guide/ug_troubleshooting.rst index 9e6f39941..a8a9c2c4d 100644 --- a/doc/source/user_guide/ug_troubleshooting.rst +++ b/doc/source/user_guide/ug_troubleshooting.rst @@ -119,17 +119,24 @@ Several utilities are available that can be helpful when debugging the code. Not all of these will work everywhere in the code, due to possible conflicts in module dependencies. -*debug\_ice* (**CICE.F90**) +*debug\_ice* (**ice\_diagnostics.F90**) A wrapper for *print\_state* that is easily called from numerous - points during the timestepping loop (see - **CICE\_RunMod.F90\_debug**, which can be substituted for - **CICE\_RunMod.F90**). + points during the timestepping loop. *print\_state* (**ice\_diagnostics.F90**) Print the ice state and forcing fields for a given grid cell. -`dbug` = true (**ice\_in**) - Print numerous diagnostic quantities. +`forcing\_diag` = true (**ice\_in**) + Print numerous diagnostic quantities associated with input forcing. + +`debug\_blocks` = true (**ice\_in**) + Print diagnostics during block decomposition and distribution. + +`debug\_model` = true (**ice\_in**) + Print extended diagnostics for the first point associated with `print\_points`. + +`debug\_model\_step` = true (**ice\_in**) + Timestep to starting printing diagnostics associated with `debug\_model`. `print\_global` (**ice\_in**) If true, compute and print numerous global sums for energy and mass @@ -138,11 +145,11 @@ conflicts in module dependencies. `print\_points` (**ice\_in**) If true, print numerous diagnostic quantities for two grid cells, - one near the north pole and one in the Weddell Sea. This utility + defined by `lonpnt` and `latpnt` in the namelist file. + This utility also provides the local grid indices and block and processor numbers (`ip`, `jp`, `iblkp`, `mtask`) for these points, which can be used in - conjunction with `check\_step`, to call *print\_state*. These flags - are set in **ice\_diagnostics.F90**. This option can be fairly slow, + to call *print\_state*. This option can be fairly slow, due to gathering data from processors. `conserv\_check` = true (**ice\_in**) diff --git a/icepack b/icepack index 8bc17e1ee..9a7e22089 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 8bc17e1eee235fb0e26857119175990aa0102613 +Subproject commit 9a7e220890f70d2654314cbb023b9137f15d6327 From 9d88d928209d988b1e6cde1240796e479414259b Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 10 Jun 2021 18:08:12 -0400 Subject: [PATCH 37/44] add cice changes for zlvs (#29) --- cicecore/cicedynB/general/ice_flux.F90 | 9 ++++++--- cicecore/cicedynB/general/ice_step_mod.F90 | 3 ++- doc/source/cice_index.rst | 3 ++- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/cicecore/cicedynB/general/ice_flux.F90 b/cicecore/cicedynB/general/ice_flux.F90 index 06b371c3c..53b326808 100644 --- a/cicecore/cicedynB/general/ice_flux.F90 +++ b/cicecore/cicedynB/general/ice_flux.F90 @@ -121,7 +121,8 @@ module ice_flux ! in from atmosphere (if calc_Tsfc) real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & - zlvl , & ! atm level height (m) + zlvl , & ! atm level height (momentum) (m) + zlvs , & ! atm level height (scalar quantities) (m) uatm , & ! wind velocity components (m/s) vatm , & wind , & ! wind speed (m/s) @@ -391,7 +392,8 @@ subroutine alloc_flux iceumask (nx_block,ny_block,max_blocks), & ! ice extent mask (U-cell) fm (nx_block,ny_block,max_blocks), & ! Coriolis param. * mass in U-cell (kg/s) Tbu (nx_block,ny_block,max_blocks), & ! factor for seabed stress (landfast ice) - zlvl (nx_block,ny_block,max_blocks), & ! atm level height (m) + zlvl (nx_block,ny_block,max_blocks), & ! atm level height (momentum) (m) + zlvs (nx_block,ny_block,max_blocks), & ! atm level height (scalar quantities) (m) uatm (nx_block,ny_block,max_blocks), & ! wind velocity components (m/s) vatm (nx_block,ny_block,max_blocks), & wind (nx_block,ny_block,max_blocks), & ! wind speed (m/s) @@ -570,7 +572,8 @@ subroutine init_coupler_flux !----------------------------------------------------------------- ! fluxes received from atmosphere !----------------------------------------------------------------- - zlvl (:,:,:) = c10 ! atm level height (m) + zlvl (:,:,:) = c10 ! atm level height (momentum) (m) + zlvs (:,:,:) = c10 ! atm level height (scalar quantities) (m) rhoa (:,:,:) = 1.3_dbl_kind ! air density (kg/m^3) uatm (:,:,:) = c5 ! wind velocity (m/s) vatm (:,:,:) = c5 diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 29bfdbf0e..d65cf52d3 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -171,7 +171,7 @@ subroutine step_therm1 (dt, iblk) use ice_domain_size, only: ncat, nilyr, nslyr, n_iso, n_aero 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, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & + wind, rhoa, potT, Qa, zlvl, zlvs, strax, stray, flatn, fsensn, fsurfn, fcondtopn, & flw, fsnow, fpond, sss, mlt_onset, frz_onset, fcondbotn, fcondbot, & frain, Tair, strairxT, strairyT, fsurf, fcondtop, fsens, & flat, fswabs, flwout, evap, evaps, evapi, Tref, Qref, Uref, fresh, fsalt, fhocn, & @@ -358,6 +358,7 @@ subroutine step_therm1 (dt, iblk) vatm = vatm (i,j, iblk), & wind = wind (i,j, iblk), & zlvl = zlvl (i,j, iblk), & + zlvs = zlvs (i,j, iblk), & Qa = Qa (i,j, iblk), & Qa_iso = Qa_iso (i,j,:,iblk), & rhoa = rhoa (i,j, iblk), & diff --git a/doc/source/cice_index.rst b/doc/source/cice_index.rst index 9e2868947..69222e10c 100644 --- a/doc/source/cice_index.rst +++ b/doc/source/cice_index.rst @@ -691,7 +691,8 @@ either Celsius or Kelvin units). "yieldstress11(12, 22)", "yield stress tensor components", "" "year_init", ":math:`\bullet` the initial year", "" "**Z**", "", "" - "zlvl", "atmospheric level height", "m" + "zlvl", "atmospheric level height (momentum)", "m" + "zlvs", "atmospheric level height (scalars)", "m" "zref", "reference height for stability", "10. m" "zTrf", "reference height for :math:`T_{ref}`, :math:`Q_{ref}`, :math:`U_{ref}`", "2. m" "zvir", "gas constant (water vapor)/gas constant (air) - 1", "0.606" From f3b26524302859f93c7c93b2bcf0e140434cd2e2 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 24 Jun 2021 08:32:44 -0400 Subject: [PATCH 38/44] update icepack and pointer --- .gitmodules | 3 ++- icepack | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8a773d230..b84a13b43 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,4 @@ [submodule "icepack"] path = icepack - url = https://github.com/NOAA-EMC/Icepack + #url = https://github.com/NOAA-EMC/Icepack + url = https://github.com/DeniseWorthen/Icepack diff --git a/icepack b/icepack index 9a7e22089..0f0e1b2aa 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 9a7e220890f70d2654314cbb023b9137f15d6327 +Subproject commit 0f0e1b2aada8cb49655b65dbf721cf6549ce7b51 From 55586f764d7260ce9740ca880a9dc0118dca2313 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 20 Jul 2021 11:21:12 -0400 Subject: [PATCH 39/44] update icepack and revert gitmodules --- .gitmodules | 3 +-- icepack | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index b84a13b43..8a773d230 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,3 @@ [submodule "icepack"] path = icepack - #url = https://github.com/NOAA-EMC/Icepack - url = https://github.com/DeniseWorthen/Icepack + url = https://github.com/NOAA-EMC/Icepack diff --git a/icepack b/icepack index 0f0e1b2aa..41cc89d0a 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 0f0e1b2aada8cb49655b65dbf721cf6549ce7b51 +Subproject commit 41cc89d0afc0494c545adaacd2082cc5f2da6959 From 7f089d01893c1c229dcf0a70c046ced43c712754 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 23 Aug 2021 08:19:25 -0400 Subject: [PATCH 40/44] add memory profiling (#36) * add profile_memory calls to CICE cap --- .../drivers/nuopc/cmeps/ice_comp_nuopc.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 index a832e7bdf..9d650d1ff 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_comp_nuopc.F90 @@ -88,6 +88,7 @@ module ice_comp_nuopc integer :: nthrds ! Number of threads to use in this component integer :: dbug = 0 + logical :: profile_memory = .false. integer , parameter :: debug_import = 0 ! internal debug level integer , parameter :: debug_export = 0 ! internal debug level character(*), parameter :: modName = "(ice_comp_nuopc)" @@ -157,6 +158,10 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc + + logical :: isPresent, isSet + character(len=64) :: value + character(len=char_len_long) :: logmsg !-------------------------------- rc = ESMF_SUCCESS @@ -166,6 +171,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) acceptStringList=(/"IPDv01p"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + profile_memory = .false. + call NUOPC_CompAttributeGet(gcomp, name="ProfileMemory", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) profile_memory=(trim(value)=="true") + write(logmsg,*) profile_memory + call ESMF_LogWrite('CICE_cap:ProfileMemory = '//trim(logmsg), ESMF_LOGMSG_INFO) + end subroutine InitializeP0 !=============================================================================== @@ -902,6 +915,8 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering CICE Model_ADVANCE: ") + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clock, importState and exportState @@ -1049,7 +1064,9 @@ subroutine ModelAdvance(gcomp, rc) ! Advance cice and timestep update !-------------------------------- + if(profile_memory) call ESMF_VMLogMemInfo("Entering CICE_Run : ") call CICE_Run() + if(profile_memory) call ESMF_VMLogMemInfo("Leaving CICE_Run : ") !-------------------------------- ! Create export state @@ -1110,6 +1127,8 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving CICE Model_ADVANCE: ") + end subroutine ModelAdvance !=============================================================================== From 2540695698e1a733af9ce74609365faf4cb35d66 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 16 Sep 2021 08:28:30 -0400 Subject: [PATCH 41/44] Update CICE for latest Consortium master (#38) * Implement advanced snow physics in icepack and CICE * Fix time-stamping of CICE history files * Fix CICE history file precision --- .../cicedynB/analysis/ice_diagnostics.F90 | 85 +- .../cicedynB/analysis/ice_diagnostics_bgc.F90 | 15 +- cicecore/cicedynB/analysis/ice_history.F90 | 226 +- .../cicedynB/analysis/ice_history_fsd.F90 | 2 +- .../cicedynB/analysis/ice_history_pond.F90 | 8 +- .../cicedynB/analysis/ice_history_shared.F90 | 99 +- .../cicedynB/analysis/ice_history_snow.F90 | 430 ++ cicecore/cicedynB/dynamics/ice_dyn_eap.F90 | 12 +- cicecore/cicedynB/dynamics/ice_dyn_evp.F90 | 227 +- cicecore/cicedynB/dynamics/ice_dyn_evp_1d.F90 | 3906 ++++++++--------- cicecore/cicedynB/dynamics/ice_dyn_shared.F90 | 47 +- cicecore/cicedynB/dynamics/ice_dyn_vp.F90 | 44 +- .../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 | 304 +- cicecore/cicedynB/general/ice_step_mod.F90 | 220 +- .../infrastructure/comm/mpi/ice_boundary.F90 | 133 +- .../comm/mpi/ice_gather_scatter.F90 | 138 +- .../comm/serial/ice_boundary.F90 | 133 +- .../comm/serial/ice_gather_scatter.F90 | 40 +- .../cicedynB/infrastructure/ice_domain.F90 | 2 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 54 +- .../infrastructure/ice_read_write.F90 | 765 +++- .../io/io_binary/ice_restart.F90 | 61 +- .../io/io_netcdf/ice_history_write.F90 | 357 +- .../io/io_netcdf/ice_restart.F90 | 15 +- .../io/io_pio2/ice_history_write.F90 | 448 +- .../infrastructure/io/io_pio2/ice_pio.F90 | 66 +- .../infrastructure/io/io_pio2/ice_restart.F90 | 23 +- .../drivers/nuopc/cmeps/ice_import_export.F90 | 2 +- .../drivers/standalone/cice/CICE_InitMod.F90 | 52 +- .../drivers/standalone/cice/CICE_RunMod.F90 | 27 +- cicecore/drivers/unittest/bcstchk/bcstchk.F90 | 32 +- cicecore/drivers/unittest/calchk/calchk.F90 | 33 +- .../unittest/helloworld/helloworld.F90 | 5 +- cicecore/drivers/unittest/sumchk/sumchk.F90 | 7 +- cicecore/shared/ice_arrays_column.F90 | 11 + cicecore/shared/ice_calendar.F90 | 33 +- cicecore/shared/ice_fileunits.F90 | 6 + cicecore/shared/ice_init_column.F90 | 77 +- cicecore/shared/ice_restart_column.F90 | 91 +- cicecore/version.txt | 2 +- configuration/scripts/cice.batch.csh | 17 + configuration/scripts/cice.launch.csh | 6 + configuration/scripts/cice.run.setup.csh | 2 +- configuration/scripts/ice_in | 41 +- .../scripts/machines/Macros.gaea_intel | 56 + .../scripts/machines/Macros.onyx_cray | 2 +- .../scripts/machines/Macros.onyx_gnu | 2 +- configuration/scripts/machines/env.gaea_intel | 34 + configuration/scripts/machines/env.onyx_cray | 13 +- configuration/scripts/machines/env.onyx_gnu | 13 +- configuration/scripts/machines/env.onyx_intel | 13 +- configuration/scripts/options/set_nml.alt04 | 2 +- configuration/scripts/options/set_nml.evp1d | 1 + configuration/scripts/options/set_nml.gx1prod | 4 +- .../scripts/options/set_nml.gx1prod15 | 19 + .../scripts/options/set_nml.histinst | 1 + configuration/scripts/options/set_nml.kevp102 | 1 - configuration/scripts/options/set_nml.qc | 10 +- .../scripts/options/set_nml.run10year | 7 + .../scripts/options/set_nml.snw30percent | 5 + .../scripts/options/set_nml.snwITDrdg | 10 + .../scripts/options/set_nml.snwgrain | 15 + configuration/scripts/tests/QC/cice.t-test.py | 9 + configuration/scripts/tests/base_suite.ts | 9 +- configuration/scripts/tests/comparelog.csh | 4 +- configuration/scripts/tests/io_suite.ts | 6 + configuration/scripts/tests/prod_suite.ts | 4 + configuration/scripts/tests/reprosum_suite.ts | 1 + .../scripts/tests/test_unittest.script | 27 +- doc/source/cice_index.rst | 34 +- doc/source/conf.py | 4 +- doc/source/developer_guide/dg_driver.rst | 11 +- 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/science_guide/sg_tracers.rst | 6 +- doc/source/user_guide/figures/CICE_Bgrid.png | Bin 0 -> 53070 bytes doc/source/user_guide/ug_case_settings.rst | 39 +- doc/source/user_guide/ug_implementation.rst | 39 +- doc/source/user_guide/ug_testing.rst | 9 + doc/source/user_guide/ug_troubleshooting.rst | 3 - icepack | 2 +- 85 files changed, 5657 insertions(+), 3514 deletions(-) create mode 100644 cicecore/cicedynB/analysis/ice_history_snow.F90 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/machines/Macros.gaea_intel create mode 100755 configuration/scripts/machines/env.gaea_intel create mode 100644 configuration/scripts/options/set_nml.evp1d create mode 100644 configuration/scripts/options/set_nml.gx1prod15 create mode 100644 configuration/scripts/options/set_nml.histinst delete mode 100644 configuration/scripts/options/set_nml.kevp102 create mode 100644 configuration/scripts/options/set_nml.run10year 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 create mode 100644 configuration/scripts/tests/prod_suite.ts create mode 100755 doc/source/user_guide/figures/CICE_Bgrid.png diff --git a/cicecore/cicedynB/analysis/ice_diagnostics.F90 b/cicecore/cicedynB/analysis/ice_diagnostics.F90 index 6b9b32301..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,27 @@ 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 pevap(n) = evap(i,j,iblk)*dt/rhoi ! sublimation/condensation @@ -876,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)) @@ -1059,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) @@ -1596,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) @@ -1638,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..0ecc2ee5a 100644 --- a/cicecore/cicedynB/analysis/ice_history.F90 +++ b/cicecore/cicedynB/analysis/ice_history.F90 @@ -32,7 +32,7 @@ module ice_history use ice_kinds_mod use ice_communicate, only: my_task, master_task use ice_constants, only: c0, c1, c2, c100, c360, c180, & - p001, p25, p5, mps_to_cmpdy, kg_to_g, spval + p001, p25, p5, mps_to_cmpdy, kg_to_g, spval_dbl use ice_fileunits, only: nu_nml, nml_filename, nu_diag, & get_fileunit, release_fileunit, flush_fileunit use ice_exit, only: abort_ice @@ -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 @@ -1758,6 +1768,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 @@ -1775,7 +1786,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 +1802,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) @@ -1814,7 +1825,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 +1873,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 @@ -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 @@ -3105,7 +3118,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a2D(i,j,n,iblk) = spval + a2D(i,j,n,iblk) = spval_dbl else ! convert units a2D(i,j,n,iblk) = avail_hist_fields(n)%cona*a2D(i,j,n,iblk) & * ravgct + avail_hist_fields(n)%conb @@ -3122,7 +3135,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sithick(ns),iblk) = & a2D(i,j,n_sithick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sithick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sithick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3135,7 +3148,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siage(ns),iblk) = & a2D(i,j,n_siage(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siage(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siage(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3148,7 +3161,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sisnthick(ns),iblk) = & a2D(i,j,n_sisnthick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sisnthick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sisnthick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3161,7 +3174,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitemptop(ns),iblk) = & a2D(i,j,n_sitemptop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitemptop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitemptop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3174,7 +3187,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitempsnic(ns),iblk) = & a2D(i,j,n_sitempsnic(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempsnic(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitempsnic(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3187,7 +3200,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sitempbot(ns),iblk) = & a2D(i,j,n_sitempbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sitempbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sitempbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3200,7 +3213,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siu(ns),iblk) = & a2D(i,j,n_siu(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siu(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siu(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3213,7 +3226,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siv(ns),iblk) = & a2D(i,j,n_siv(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siv(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siv(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3226,7 +3239,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrxdtop(ns),iblk) = & a2D(i,j,n_sistrxdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrxdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3239,7 +3252,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrydtop(ns),iblk) = & a2D(i,j,n_sistrydtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrydtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrydtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3252,7 +3265,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistrxubot(ns),iblk) = & a2D(i,j,n_sistrxubot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistrxubot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistrxubot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3265,7 +3278,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sistryubot(ns),iblk) = & a2D(i,j,n_sistryubot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sistryubot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sistryubot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3278,7 +3291,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sicompstren(ns),iblk) = & a2D(i,j,n_sicompstren(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sicompstren(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sicompstren(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3291,7 +3304,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sispeed(ns),iblk) = & a2D(i,j,n_sispeed(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sispeed(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sispeed(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3304,8 +3317,8 @@ subroutine accum_hist (dt) a2D(i,j,n_sialb(ns),iblk) = & a2D(i,j,n_sialb(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sialb(ns),iblk) = spval - if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n_sialb(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sialb(ns),iblk) = spval_dbl + if (albcnt(i,j,iblk,ns) <= puny) a2D(i,j,n_sialb(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3318,7 +3331,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswdtop(ns),iblk) = & a2D(i,j,n_siflswdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3331,7 +3344,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswutop(ns),iblk) = & a2D(i,j,n_siflswutop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswutop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswutop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3344,7 +3357,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflswdbot(ns),iblk) = & a2D(i,j,n_siflswdbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflswdbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflswdbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3357,7 +3370,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllwdtop(ns),iblk) = & a2D(i,j,n_sifllwdtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwdtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllwdtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3370,7 +3383,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllwutop(ns),iblk) = & a2D(i,j,n_sifllwutop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllwutop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllwutop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3383,7 +3396,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsenstop(ns),iblk) = & a2D(i,j,n_siflsenstop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsenstop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsenstop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3396,7 +3409,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsensupbot(ns),iblk) = & a2D(i,j,n_siflsensupbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsensupbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsensupbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3409,7 +3422,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifllatstop(ns),iblk) = & a2D(i,j,n_sifllatstop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifllatstop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifllatstop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3422,7 +3435,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sipr(ns),iblk) = & a2D(i,j,n_sipr(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sipr(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sipr(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3435,7 +3448,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sifb(ns),iblk) = & a2D(i,j,n_sifb(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sifb(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sifb(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3448,7 +3461,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflcondtop(ns),iblk) = & a2D(i,j,n_siflcondtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflcondtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3461,7 +3474,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflcondbot(ns),iblk) = & a2D(i,j,n_siflcondbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflcondbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflcondbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3474,7 +3487,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflsaltbot(ns),iblk) = & a2D(i,j,n_siflsaltbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflsaltbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflsaltbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3487,7 +3500,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflfwbot(ns),iblk) = & a2D(i,j,n_siflfwbot(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwbot(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflfwbot(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3500,7 +3513,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siflfwdrain(ns),iblk) = & a2D(i,j,n_siflfwdrain(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siflfwdrain(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siflfwdrain(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3513,7 +3526,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sidragtop(ns),iblk) = & a2D(i,j,n_sidragtop(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sidragtop(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sidragtop(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3526,7 +3539,7 @@ subroutine accum_hist (dt) a2D(i,j,n_sirdgthick(ns),iblk) = & a2D(i,j,n_sirdgthick(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_sirdgthick(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_sirdgthick(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3539,7 +3552,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcetiltx(ns),iblk) = & a2D(i,j,n_siforcetiltx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetiltx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcetiltx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3552,7 +3565,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcetilty(ns),iblk) = & a2D(i,j,n_siforcetilty(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcetilty(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcetilty(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3565,7 +3578,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcecoriolx(ns),iblk) = & a2D(i,j,n_siforcecoriolx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecoriolx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcecoriolx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3578,7 +3591,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforcecorioly(ns),iblk) = & a2D(i,j,n_siforcecorioly(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforcecorioly(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforcecorioly(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3591,7 +3604,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforceintstrx(ns),iblk) = & a2D(i,j,n_siforceintstrx(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstrx(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstrx(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -3604,7 +3617,7 @@ subroutine accum_hist (dt) a2D(i,j,n_siforceintstry(ns),iblk) = & a2D(i,j,n_siforceintstry(ns),iblk)*avgct(ns)*ravgip(i,j) endif - if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstry(ns),iblk) = spval + if (ravgip(i,j) == c0) a2D(i,j,n_siforceintstry(ns),iblk) = spval_dbl enddo ! i enddo ! j endif @@ -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 @@ -3680,7 +3724,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Dc(i,j,k,n,iblk) = spval + a3Dc(i,j,k,n,iblk) = spval_dbl else ! convert units a3Dc(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Dc(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3729,7 +3773,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Dz(i,j,k,n,iblk) = spval + a3Dz(i,j,k,n,iblk) = spval_dbl else ! convert units a3Dz(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Dz(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3746,7 +3790,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Db(i,j,k,n,iblk) = spval + a3Db(i,j,k,n,iblk) = spval_dbl else ! convert units a3Db(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Db(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3764,7 +3808,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Da(i,j,k,n,iblk) = spval + a3Da(i,j,k,n,iblk) = spval_dbl else ! convert units a3Da(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Da(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3782,7 +3826,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a3Df(i,j,k,n,iblk) = spval + a3Df(i,j,k,n,iblk) = spval_dbl else ! convert units a3Df(i,j,k,n,iblk) = avail_hist_fields(nn)%cona*a3Df(i,j,k,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3801,7 +3845,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Di(i,j,k,ic,n,iblk) = spval + a4Di(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Di(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Di(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3821,7 +3865,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Ds(i,j,k,ic,n,iblk) = spval + a4Ds(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Ds(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Ds(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3841,7 +3885,7 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - a4Df(i,j,k,ic,n,iblk) = spval + a4Df(i,j,k,ic,n,iblk) = spval_dbl else ! convert units a4Df(i,j,k,ic,n,iblk) = avail_hist_fields(nn)%cona*a4Df(i,j,k,ic,n,iblk) & * ravgct + avail_hist_fields(nn)%conb @@ -3871,32 +3915,32 @@ subroutine accum_hist (dt) do j = jlo, jhi do i = ilo, ihi if (.not. tmask(i,j,iblk)) then ! mask out land points - if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns), iblk) = spval - if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns), iblk) = spval - if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns), iblk) = spval - if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns), iblk) = spval - if (n_sigP (ns) /= 0) a2D(i,j,n_sigP(ns), iblk) = spval - if (n_sistreave(ns) /= 0) a2D(i,j,n_sistreave(ns),iblk) = spval - if (n_sistremax(ns) /= 0) a2D(i,j,n_sistremax(ns),iblk) = spval - if (n_mlt_onset(ns) /= 0) a2D(i,j,n_mlt_onset(ns),iblk) = spval - if (n_frz_onset(ns) /= 0) a2D(i,j,n_frz_onset(ns),iblk) = spval - if (n_hisnap (ns) /= 0) a2D(i,j,n_hisnap(ns), iblk) = spval - if (n_aisnap (ns) /= 0) a2D(i,j,n_aisnap(ns), iblk) = spval - if (n_trsig (ns) /= 0) a2D(i,j,n_trsig(ns), iblk) = spval - if (n_iage (ns) /= 0) a2D(i,j,n_iage(ns), iblk) = spval - if (n_FY (ns) /= 0) a2D(i,j,n_FY(ns), iblk) = spval - - if (n_a11 (ns) /= 0) a2D(i,j,n_a11(ns), iblk) = spval - if (n_a12 (ns) /= 0) a2D(i,j,n_a12(ns), iblk) = spval - if (n_e11 (ns) /= 0) a2D(i,j,n_e11(ns), iblk) = spval - if (n_e12 (ns) /= 0) a2D(i,j,n_e12(ns), iblk) = spval - if (n_e22 (ns) /= 0) a2D(i,j,n_e22(ns), iblk) = spval - if (n_s11 (ns) /= 0) a2D(i,j,n_s11(ns), iblk) = spval - if (n_s12 (ns) /= 0) a2D(i,j,n_s12(ns), iblk) = spval - if (n_s22 (ns) /= 0) a2D(i,j,n_s22(ns), iblk) = spval - if (n_yieldstress11 (ns) /= 0) a2D(i,j,n_yieldstress11(ns),iblk) = spval - if (n_yieldstress12 (ns) /= 0) a2D(i,j,n_yieldstress12(ns),iblk) = spval - if (n_yieldstress22 (ns) /= 0) a2D(i,j,n_yieldstress22(ns),iblk) = spval + if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns), iblk) = spval_dbl + if (n_shear (ns) /= 0) a2D(i,j,n_shear(ns), iblk) = spval_dbl + if (n_sig1 (ns) /= 0) a2D(i,j,n_sig1(ns), iblk) = spval_dbl + if (n_sig2 (ns) /= 0) a2D(i,j,n_sig2(ns), iblk) = spval_dbl + if (n_sigP (ns) /= 0) a2D(i,j,n_sigP(ns), iblk) = spval_dbl + if (n_sistreave(ns) /= 0) a2D(i,j,n_sistreave(ns),iblk) = spval_dbl + if (n_sistremax(ns) /= 0) a2D(i,j,n_sistremax(ns),iblk) = spval_dbl + if (n_mlt_onset(ns) /= 0) a2D(i,j,n_mlt_onset(ns),iblk) = spval_dbl + if (n_frz_onset(ns) /= 0) a2D(i,j,n_frz_onset(ns),iblk) = spval_dbl + if (n_hisnap (ns) /= 0) a2D(i,j,n_hisnap(ns), iblk) = spval_dbl + if (n_aisnap (ns) /= 0) a2D(i,j,n_aisnap(ns), iblk) = spval_dbl + if (n_trsig (ns) /= 0) a2D(i,j,n_trsig(ns), iblk) = spval_dbl + if (n_iage (ns) /= 0) a2D(i,j,n_iage(ns), iblk) = spval_dbl + if (n_FY (ns) /= 0) a2D(i,j,n_FY(ns), iblk) = spval_dbl + + if (n_a11 (ns) /= 0) a2D(i,j,n_a11(ns), iblk) = spval_dbl + if (n_a12 (ns) /= 0) a2D(i,j,n_a12(ns), iblk) = spval_dbl + if (n_e11 (ns) /= 0) a2D(i,j,n_e11(ns), iblk) = spval_dbl + if (n_e12 (ns) /= 0) a2D(i,j,n_e12(ns), iblk) = spval_dbl + if (n_e22 (ns) /= 0) a2D(i,j,n_e22(ns), iblk) = spval_dbl + if (n_s11 (ns) /= 0) a2D(i,j,n_s11(ns), iblk) = spval_dbl + if (n_s12 (ns) /= 0) a2D(i,j,n_s12(ns), iblk) = spval_dbl + if (n_s22 (ns) /= 0) a2D(i,j,n_s22(ns), iblk) = spval_dbl + if (n_yieldstress11 (ns) /= 0) a2D(i,j,n_yieldstress11(ns),iblk) = spval_dbl + if (n_yieldstress12 (ns) /= 0) a2D(i,j,n_yieldstress12(ns),iblk) = spval_dbl + if (n_yieldstress22 (ns) /= 0) a2D(i,j,n_yieldstress22(ns),iblk) = spval_dbl else if (n_divu (ns) /= 0) a2D(i,j,n_divu(ns),iblk) = & divu (i,j,iblk)*avail_hist_fields(n_divu(ns))%cona @@ -3966,8 +4010,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 @@ -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..9b58deeec 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 @@ -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/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_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..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) @@ -610,12 +607,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_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 f3685ed61..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) !======================================================================= @@ -1204,10 +1201,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 +1302,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/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 b896c3bb9..3d102217a 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,15 +91,19 @@ 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, & 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, & @@ -128,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 @@ -187,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, & @@ -201,7 +208,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, & @@ -227,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, & @@ -329,7 +343,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 @@ -409,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 @@ -472,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 @@ -545,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 @@ -669,7 +708,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) @@ -734,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) @@ -797,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) @@ -877,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 @@ -985,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' @@ -1014,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 @@ -1048,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 @@ -1293,16 +1415,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 @@ -1652,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)' @@ -1665,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' @@ -1702,13 +1897,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) @@ -1786,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 @@ -1815,19 +2011,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 @@ -1858,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, & @@ -1883,6 +2075,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 @@ -1918,10 +2111,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) :: & @@ -1934,12 +2129,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) @@ -2016,6 +2214,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 @@ -2246,7 +2452,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 @@ -2262,22 +2468,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__) @@ -2309,6 +2519,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/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 010a5c8c4..0a58769db 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() @@ -1351,8 +1254,9 @@ 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 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_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 418c80f61..4b0bb1f9e 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 @@ -703,8 +687,9 @@ 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 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/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 2124bbebe..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,13 +78,17 @@ 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 - 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 :: & @@ -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) @@ -175,12 +183,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 @@ -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/cicecore/cicedynB/infrastructure/ice_read_write.F90 b/cicecore/cicedynB/infrastructure/ice_read_write.F90 index d902c62f8..bf0361cf1 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 @@ -285,7 +288,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 +307,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 +436,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 +455,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 +569,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 +585,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 +689,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 +708,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 +803,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 +813,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 +908,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 +918,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 +1014,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 +1024,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 +1058,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 +1114,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 +1171,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 +1204,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 +1229,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 +1271,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,27 +1319,33 @@ 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 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 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 +1378,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 +1411,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 +1436,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 +1483,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,26 +1538,34 @@ 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 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 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 +1598,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 +1631,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 +1656,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 +1707,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 +1750,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 + 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 +1805,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,28 +1818,299 @@ 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 !======================================================================= +! 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, & @@ -1736,16 +2147,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 +2175,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 +2207,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 +2220,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 +2235,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 +2271,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: @@ -1841,7 +2286,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 @@ -1886,7 +2331,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 +2341,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 +2394,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: @@ -1965,7 +2410,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 @@ -2016,7 +2461,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 +2471,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 +2485,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 @@ -2094,7 +2539,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 @@ -2117,9 +2562,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 +2574,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 +2597,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 +2643,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 @@ -2249,7 +2702,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 @@ -2279,9 +2732,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 +2743,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 +2759,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 +2784,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 +2837,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 +2848,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 +2863,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 +2899,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/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_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_netcdf/ice_history_write.F90 index 9c6b30ee1..493a91c1e 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 @@ -67,11 +67,9 @@ subroutine ice_write_hist (ns) ! local variables - real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 - real (kind=real_kind), dimension(:,:), allocatable :: work_gr - real (kind=real_kind), dimension(:,:,:), allocatable :: work_gr3 - real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: & - work1 + real (kind=dbl_kind), dimension(:,:), allocatable :: work_g1 + real (kind=dbl_kind), dimension(:,:,:), allocatable :: work1_3 + real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: work1 integer (kind=int_kind) :: i,k,ic,n,nn, & ncid,status,imtid,jmtid,kmtidi,kmtids,kmtidb, cmtid,timid,varid, & @@ -205,7 +203,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 +212,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 +256,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') @@ -361,20 +360,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', coord_var(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//coord_var(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//coord_var(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//coord_var(i)%short_name) + call ice_write_hist_fill(ncid,varid,coord_var(i)%short_name,history_precision) if (coord_var(i)%short_name == 'ULAT') then status = nf90_put_att(ncid,varid,'comment', & 'Latitude of NE corner of T grid cell') @@ -421,18 +407,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask units') status = nf90_put_att(ncid,varid,'comment', '0 = land, 1 = ocean') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: tmask comment') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for tmask') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for tmask') + call ice_write_hist_fill(ncid,varid,'tmask',history_precision) endif if (igrd(n_blkmask)) then @@ -444,18 +419,7 @@ subroutine ice_write_hist (ns) if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask units') status = nf90_put_att(ncid,varid,'comment', 'mytask + iblk/100') if (status /= nf90_noerr) call abort_ice(subname//'ERROR: blkmask comment') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining missing_value for blkmask') - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname//'ERROR: defining _FillValue for blkmask') + call ice_write_hist_fill(ncid,varid,'blkmask',history_precision) endif do i = 3, nvar ! note n_tmask=1, n_blkmask=2 @@ -473,20 +437,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'coordinates', var(i)%coordinates) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining coordinates for '//var(i)%req%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//var(i)%req%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//var(i)%req%short_name) + call ice_write_hist_fill(ncid,varid,var(i)%req%short_name,history_precision) endif enddo @@ -506,20 +457,7 @@ subroutine ice_write_hist (ns) status = nf90_put_att(ncid, varid, 'units', var_nverts(i)%units) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining units for '//var_nverts(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//var_nverts(i)%short_name) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//var_nverts(i)%short_name) + call ice_write_hist_fill(ncid,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -545,20 +483,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -575,7 +500,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) & @@ -616,20 +542,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -640,7 +553,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') @@ -675,20 +589,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Dz @@ -720,20 +621,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Db @@ -765,20 +653,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Da @@ -810,20 +685,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) endif enddo ! num_avail_hist_fields_3Df @@ -857,20 +719,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -881,7 +730,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') @@ -918,20 +768,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -942,7 +779,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') @@ -979,20 +817,7 @@ subroutine ice_write_hist (ns) avail_hist_fields(n)%vcellmeas) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: defining cell measures for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'missing_value',spval) - else - status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining missing_value for '//avail_hist_fields(n)%vname) - if (lprecision == nf90_float) then - status = nf90_put_att(ncid,varid,'_FillValue',spval) - else - status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) - endif - if (status /= nf90_noerr) call abort_ice(subname// & - 'ERROR: defining _FillValue for '//avail_hist_fields(n)%vname) + call ice_write_hist_fill(ncid,varid,avail_hist_fields(n)%vname,history_precision) !----------------------------------------------------------------- ! Add cell_methods attribute to variables if averaged @@ -1003,7 +828,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') @@ -1114,9 +940,7 @@ subroutine ice_write_hist (ns) if (my_task==master_task) then allocate(work_g1(nx_global,ny_global)) - allocate(work_gr(nx_global,ny_global)) else - allocate(work_gr(1,1)) ! to save memory allocate(work_g1(1,1)) endif @@ -1147,11 +971,10 @@ subroutine ice_write_hist (ns) END SELECT if (my_task == master_task) then - work_gr = work_g1 status = nf90_inq_varid(ncid, coord_var(i)%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//coord_var(i)%short_name) - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing'//coord_var(i)%short_name) endif @@ -1193,11 +1016,10 @@ subroutine ice_write_hist (ns) if (igrd(n_tmask)) then call gather_global(work_g1, hm, master_task, distrb_info) if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, 'tmask', varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for tmask') - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable tmask') endif @@ -1206,11 +1028,10 @@ subroutine ice_write_hist (ns) if (igrd(n_blkmask)) then call gather_global(work_g1, bm, master_task, distrb_info) if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, 'blkmask', varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for blkmask') - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable blkmask') endif @@ -1243,31 +1064,28 @@ subroutine ice_write_hist (ns) END SELECT if (my_task == master_task) then - work_gr=work_g1 status = nf90_inq_varid(ncid, var(i)%req%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//var(i)%req%short_name) - status = nf90_put_var(ncid,varid,work_gr) + status = nf90_put_var(ncid,varid,work_g1) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//var(i)%req%short_name) endif endif enddo - deallocate(work_gr) - !---------------------------------------------------------------- ! Write coordinates of grid box vertices !---------------------------------------------------------------- if (f_bounds) then if (my_task==master_task) then - allocate(work_gr3(nverts,nx_global,ny_global)) + allocate(work1_3(nverts,nx_global,ny_global)) else - allocate(work_gr3(1,1,1)) ! to save memory + allocate(work1_3(1,1,1)) ! to save memory endif - work_gr3(:,:,:) = c0 + work1_3(:,:,:) = c0 work1 (:,:,:) = c0 do i = 1, nvar_verts @@ -1277,25 +1095,25 @@ subroutine ice_write_hist (ns) do ivertex = 1, nverts work1(:,:,:) = lont_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('latt_bounds') do ivertex = 1, nverts work1(:,:,:) = latt_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('lonu_bounds') do ivertex = 1, nverts work1(:,:,:) = lonu_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo CASE ('latu_bounds') do ivertex = 1, nverts work1(:,:,:) = latu_bounds(ivertex,:,:,:) call gather_global(work_g1, work1, master_task, distrb_info) - if (my_task == master_task) work_gr3(ivertex,:,:) = work_g1(:,:) + if (my_task == master_task) work1_3(ivertex,:,:) = work_g1(:,:) enddo END SELECT @@ -1303,24 +1121,18 @@ subroutine ice_write_hist (ns) status = nf90_inq_varid(ncid, var_nverts(i)%short_name, varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//var_nverts(i)%short_name) - status = nf90_put_var(ncid,varid,work_gr3) + status = nf90_put_var(ncid,varid,work1_3) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//var_nverts(i)%short_name) endif enddo - deallocate(work_gr3) + deallocate(work1_3) endif !----------------------------------------------------------------- ! write variable data !----------------------------------------------------------------- - if (my_task==master_task) then - allocate(work_gr(nx_global,ny_global)) - else - allocate(work_gr(1,1)) ! to save memory - endif - work_gr(:,:) = c0 work_g1(:,:) = c0 do n=1,num_avail_hist_fields_2D @@ -1328,19 +1140,18 @@ subroutine ice_write_hist (ns) call gather_global(work_g1, a2D(:,:,n,:), & master_task, distrb_info) if (my_task == master_task) then - work_gr(:,:) = work_g1(:,:) status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & count=(/nx_global,ny_global/)) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: writing variable '//avail_hist_fields(n)%vname) endif + endif enddo ! num_avail_hist_fields_2D - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n2D + 1, n3Dccum @@ -1354,13 +1165,12 @@ subroutine ice_write_hist (ns) do k = 1, ncat_hist call gather_global(work_g1, a3Dc(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then status = nf90_inq_varid(ncid,avail_hist_fields(n)%vname,varid) if (status /= nf90_noerr) call abort_ice(subname// & 'ERROR: getting varid for '//avail_hist_fields(n)%vname) - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1370,7 +1180,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Dc - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dccum+1, n3Dzcum @@ -1384,10 +1193,9 @@ subroutine ice_write_hist (ns) do k = 1, nzilyr call gather_global(work_g1, a3Dz(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1397,7 +1205,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Dz - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dzcum+1, n3Dbcum @@ -1411,10 +1218,9 @@ subroutine ice_write_hist (ns) do k = 1, nzblyr call gather_global(work_g1, a3Db(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1424,7 +1230,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Db - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dbcum+1, n3Dacum @@ -1438,10 +1243,9 @@ subroutine ice_write_hist (ns) do k = 1, nzalyr call gather_global(work_g1, a3Da(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1451,7 +1255,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Da - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dacum+1, n3Dfcum @@ -1465,9 +1268,8 @@ subroutine ice_write_hist (ns) do k = 1, nfsd_hist call gather_global(work_g1, a3Df(:,:,k,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k/), & count=(/nx_global,ny_global,1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1477,7 +1279,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_3Df - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n3Dfcum+1, n4Dicum @@ -1492,9 +1293,8 @@ subroutine ice_write_hist (ns) do k = 1, nzilyr call gather_global(work_g1, a4Di(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1505,7 +1305,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_4Di - work_gr(:,:) = c0 work_g1(:,:) = c0 do n = n4Dicum+1, n4Dscum @@ -1520,9 +1319,8 @@ subroutine ice_write_hist (ns) do k = 1, nzslyr call gather_global(work_g1, a4Ds(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1545,9 +1343,8 @@ subroutine ice_write_hist (ns) do k = 1, nfsd_hist call gather_global(work_g1, a4Df(:,:,k,ic,nn,:), & master_task, distrb_info) - work_gr(:,:) = work_g1(:,:) if (my_task == master_task) then - status = nf90_put_var(ncid,varid,work_gr(:,:), & + status = nf90_put_var(ncid,varid,work_g1, & start=(/ 1, 1,k,ic/), & count=(/nx_global,ny_global,1, 1/)) if (status /= nf90_noerr) call abort_ice(subname// & @@ -1558,7 +1355,6 @@ subroutine ice_write_hist (ns) endif enddo ! num_avail_hist_fields_4Df - deallocate(work_gr) deallocate(work_g1) !----------------------------------------------------------------- @@ -1580,6 +1376,43 @@ subroutine ice_write_hist (ns) end subroutine ice_write_hist +!======================================================================= + + subroutine ice_write_hist_fill(ncid,varid,vname,precision) + + use ice_kinds_mod +#ifdef USE_NETCDF + use netcdf +#endif + + integer (kind=int_kind), intent(in) :: ncid ! netcdf file id + integer (kind=int_kind), intent(in) :: varid ! netcdf var id + character(len=*), intent(in) :: vname ! var name + integer (kind=int_kind), intent(in) :: precision ! precision + + ! local variables + + integer (kind=int_kind) :: status + character(len=*), parameter :: subname = '(ice_write_hist_fill)' + + if (precision == 8) then + status = nf90_put_att(ncid,varid,'missing_value',spval_dbl) + else + status = nf90_put_att(ncid,varid,'missing_value',spval) + endif + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: defining missing_value for '//trim(vname)) + + if (precision == 8) then + status = nf90_put_att(ncid,varid,'_FillValue',spval_dbl) + else + status = nf90_put_att(ncid,varid,'_FillValue',spval) + endif + if (status /= nf90_noerr) call abort_ice(subname// & + 'ERROR: defining _FillValue for '//trim(vname)) + + end subroutine ice_write_hist_fill + !======================================================================= end module ice_history_write 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_history_write.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 index 72a1ed97f..0e91d42d0 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_history_write.F90 @@ -18,6 +18,7 @@ module ice_history_write use ice_kinds_mod + use ice_constants, only: c0, c360, spval, spval_dbl use ice_fileunits, only: nu_diag use ice_exit, only: abort_ice use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted @@ -42,9 +43,9 @@ 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 use ice_domain_size, only: nx_global, ny_global, max_blocks, max_nstrm use ice_gather_scatter, only: gather_global @@ -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) @@ -116,10 +116,15 @@ subroutine ice_write_hist (ns) TYPE(coord_attributes), dimension(nvarz) :: var_nz CHARACTER (char_len), dimension(ncoord) :: coord_bounds - real (kind=dbl_kind), allocatable :: workr2(:,:,:) - real (kind=dbl_kind), allocatable :: workr3(:,:,:,:) - real (kind=dbl_kind), allocatable :: workr4(:,:,:,:,:) - real (kind=dbl_kind), allocatable :: workr3v(:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd2(:,:,:) + real (kind=dbl_kind) , allocatable :: workd3(:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd4(:,:,:,:,:) + real (kind=dbl_kind) , allocatable :: workd3v(:,:,:,:) + + real (kind=real_kind), allocatable :: workr2(:,:,:) + real (kind=real_kind), allocatable :: workr3(:,:,:,:) + real (kind=real_kind), allocatable :: workr4(:,:,:,:,:) + real (kind=real_kind), allocatable :: workr3v(:,:,:,:) character(len=char_len_long) :: & filename @@ -164,19 +169,18 @@ subroutine ice_write_hist (ns) call ice_pio_init(mode='write', filename=trim(filename), File=File, & clobber=.true., cdf64=lcdf64, iotype=iotype) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc) - call ice_pio_initdecomp(ndim3=nzilyr, iodesc=iodesc3di) - call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db) - call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da) - call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df) - call ice_pio_initdecomp(ndim3=nverts, iodesc=iodesc3dv, inner_dim=.true.) - call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di) - call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds) - call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=history_precision) + call ice_pio_initdecomp(ndim3=ncat_hist, iodesc=iodesc3dc, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzilyr, iodesc=iodesc3di, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzblyr, iodesc=iodesc3db, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzalyr, iodesc=iodesc3da, precision=history_precision) + call ice_pio_initdecomp(ndim3=nfsd_hist, iodesc=iodesc3df, precision=history_precision) + call ice_pio_initdecomp(ndim3=nverts, iodesc=iodesc3dv, inner_dim=.true., precision=history_precision) + call ice_pio_initdecomp(ndim3=nzilyr, ndim4=ncat_hist, iodesc=iodesc4di, precision=history_precision) + call ice_pio_initdecomp(ndim3=nzslyr, ndim4=ncat_hist, iodesc=iodesc4ds, precision=history_precision) + call ice_pio_initdecomp(ndim3=nfsd_hist, ndim4=ncat_hist, iodesc=iodesc4df, precision=history_precision) ltime2 = timesecs/secday - ltime = real(timesecs/secday,kind=real_kind) ! option of turning on double precision history files lprecision = pio_real @@ -186,7 +190,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 +209,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 +228,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 @@ -340,13 +344,7 @@ subroutine ice_write_hist (ns) dimid2, varid) status = pio_put_att(File,varid,'long_name',trim(coord_var(i)%long_name)) status = pio_put_att(File, varid, 'units', trim(coord_var(i)%units)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,coord_var(i)%short_name,history_precision) if (coord_var(i)%short_name == 'ULAT') then status = pio_put_att(File,varid,'comment', & trim('Latitude of NE corner of T grid cell')) @@ -378,13 +376,7 @@ subroutine ice_write_hist (ns) status = pio_def_var(File, 'tmask', lprecision, dimid2, varid) status = pio_put_att(File,varid, 'long_name', 'ocean grid mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,'tmask',history_precision) status = pio_put_att(File,varid,'comment', '0 = land, 1 = ocean') endif if (igrd(n_blkmask)) then @@ -392,13 +384,7 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,varid, 'long_name', 'ice grid block mask') status = pio_put_att(File, varid, 'coordinates', 'TLON TLAT') status = pio_put_att(File,varid,'comment', 'mytask + iblk/100') - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,'blkmask',history_precision) endif do i = 3, nvar ! note: n_tmask=1, n_blkmask=2 @@ -408,13 +394,7 @@ subroutine ice_write_hist (ns) status = pio_put_att(File,varid, 'long_name', trim(var(i)%req%long_name)) status = pio_put_att(File, varid, 'units', trim(var(i)%req%units)) status = pio_put_att(File, varid, 'coordinates', trim(var(i)%coordinates)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,var(i)%req%short_name,history_precision) endif enddo @@ -430,13 +410,7 @@ subroutine ice_write_hist (ns) pio_put_att(File,varid, 'long_name', trim(var_nverts(i)%long_name)) status = & pio_put_att(File, varid, 'units', trim(var_nverts(i)%units)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,var_nverts(i)%short_name,history_precision) endif enddo @@ -464,16 +438,10 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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 +451,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) & @@ -518,20 +487,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -560,20 +524,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -602,20 +561,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -644,20 +598,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -686,20 +635,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -734,20 +678,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -777,20 +716,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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') @@ -821,20 +755,15 @@ subroutine ice_write_hist (ns) trim(avail_hist_fields(n)%vcoord)) status = pio_put_att(File,varid,'cell_measures', & trim(avail_hist_fields(n)%vcellmeas)) - if (lprecision == pio_real) then - status = pio_put_att(File, varid, 'missing_value', spval) - status = pio_put_att(File, varid,'_FillValue',spval) - else - status = pio_put_att(File, varid, 'missing_value', spval_dbl) - status = pio_put_att(File, varid,'_FillValue',spval_dbl) - endif + call ice_write_hist_fill(File,varid,avail_hist_fields(n)%vname,history_precision) ! 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 +830,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/) @@ -921,6 +849,7 @@ subroutine ice_write_hist (ns) ! write coordinate variables !----------------------------------------------------------------- + allocate(workd2(nx_block,ny_block,nblocks)) allocate(workr2(nx_block,ny_block,nblocks)) do i = 1,ncoord @@ -928,16 +857,22 @@ subroutine ice_write_hist (ns) SELECT CASE (coord_var(i)%short_name) CASE ('TLON') ! Convert T grid longitude from -180 -> 180 to 0 to 360 - workr2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) + workd2(:,:,:) = mod(tlon(:,:,1:nblocks)*rad_to_deg + c360, c360) CASE ('TLAT') - workr2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = tlat(:,:,1:nblocks)*rad_to_deg CASE ('ULON') - workr2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = ulon(:,:,1:nblocks)*rad_to_deg CASE ('ULAT') - workr2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg + workd2(:,:,:) = ulat(:,:,1:nblocks)*rad_to_deg END SELECT - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif enddo ! Extra dimensions (NCAT, NFSD, VGRD*) @@ -981,33 +916,39 @@ subroutine ice_write_hist (ns) if (igrd(i)) then SELECT CASE (var(i)%req%short_name) CASE ('tmask') - workr2 = hm(:,:,1:nblocks) + workd2 = hm(:,:,1:nblocks) CASE ('blkmask') - workr2 = bm(:,:,1:nblocks) + workd2 = bm(:,:,1:nblocks) CASE ('tarea') - workr2 = tarea(:,:,1:nblocks) + workd2 = tarea(:,:,1:nblocks) CASE ('uarea') - workr2 = uarea(:,:,1:nblocks) + workd2 = uarea(:,:,1:nblocks) CASE ('dxu') - workr2 = dxu(:,:,1:nblocks) + workd2 = dxu(:,:,1:nblocks) CASE ('dyu') - workr2 = dyu(:,:,1:nblocks) + workd2 = dyu(:,:,1:nblocks) CASE ('dxt') - workr2 = dxt(:,:,1:nblocks) + workd2 = dxt(:,:,1:nblocks) CASE ('dyt') - workr2 = dyt(:,:,1:nblocks) + workd2 = dyt(:,:,1:nblocks) CASE ('HTN') - workr2 = HTN(:,:,1:nblocks) + workd2 = HTN(:,:,1:nblocks) CASE ('HTE') - workr2 = HTE(:,:,1:nblocks) + workd2 = HTE(:,:,1:nblocks) CASE ('ANGLE') - workr2 = ANGLE(:,:,1:nblocks) + workd2 = ANGLE(:,:,1:nblocks) CASE ('ANGLET') - workr2 = ANGLET(:,:,1:nblocks) + workd2 = ANGLET(:,:,1:nblocks) END SELECT status = pio_inq_varid(File, var(i)%req%short_name, varid) - call pio_write_darray(File, varid, iodesc2d, & - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d, & + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d, & + workr2, status, fillval=spval) + endif endif enddo @@ -1016,32 +957,40 @@ subroutine ice_write_hist (ns) !---------------------------------------------------------------- if (f_bounds) then + allocate(workd3v(nverts,nx_block,ny_block,nblocks)) allocate(workr3v(nverts,nx_block,ny_block,nblocks)) - workr3v (:,:,:,:) = c0 + workd3v (:,:,:,:) = c0 do i = 1, nvar_verts SELECT CASE (var_nverts(i)%short_name) CASE ('lont_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = lont_bounds(ivertex,:,:,1:nblocks) enddo CASE ('latt_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = latt_bounds(ivertex,:,:,1:nblocks) enddo CASE ('lonu_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = lonu_bounds(ivertex,:,:,1:nblocks) enddo CASE ('latu_bounds') do ivertex = 1, nverts - workr3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) + workd3v(ivertex,:,:,:) = latu_bounds(ivertex,:,:,1:nblocks) enddo END SELECT status = pio_inq_varid(File, var_nverts(i)%short_name, varid) - call pio_write_darray(File, varid, iodesc3dv, & - workr3v, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dv, & + workd3v, status, fillval=spval_dbl) + else + workr3v = workd3v + call pio_write_darray(File, varid, iodesc3dv, & + workr3v, status, fillval=spval) + endif enddo + deallocate(workd3v) deallocate(workr3v) endif ! f_bounds @@ -1056,20 +1005,28 @@ subroutine ice_write_hist (ns) status = pio_inq_varid(File,avail_hist_fields(n)%vname,varid) if (status /= pio_noerr) call abort_ice(subname// & 'ERROR getting varid for '//avail_hist_fields(n)%vname) - workr2(:,:,:) = a2D(:,:,n,1:nblocks) + workd2(:,:,:) = a2D(:,:,n,1:nblocks) #ifdef CESM1_PIO call pio_setframe(varid, int(1,kind=PIO_OFFSET)) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc2d,& - workr2, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc2d,& + workd2, status, fillval=spval_dbl) + else + workr2 = workd2 + call pio_write_darray(File, varid, iodesc2d,& + workr2, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_2D + deallocate(workd2) deallocate(workr2) ! 3D (category) + allocate(workd3(nx_block,ny_block,nblocks,ncat_hist)) allocate(workr3(nx_block,ny_block,nblocks,ncat_hist)) do n = n2D + 1, n3Dccum nn = n - n2D @@ -1079,7 +1036,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, ncat_hist - workr3(:,:,j,i) = a3Dc(:,:,i,nn,j) + workd3(:,:,j,i) = a3Dc(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1087,13 +1044,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3dc,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3dc,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3dc,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Dc + deallocate(workd3) deallocate(workr3) ! 3D (vertical ice) + allocate(workd3(nx_block,ny_block,nblocks,nzilyr)) allocate(workr3(nx_block,ny_block,nblocks,nzilyr)) do n = n3Dccum+1, n3Dzcum nn = n - n3Dccum @@ -1103,7 +1068,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzilyr - workr3(:,:,j,i) = a3Dz(:,:,i,nn,j) + workd3(:,:,j,i) = a3Dz(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1111,13 +1076,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3di,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3di,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3di,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Dz + deallocate(workd3) deallocate(workr3) ! 3D (vertical ice biology) + allocate(workd3(nx_block,ny_block,nblocks,nzblyr)) allocate(workr3(nx_block,ny_block,nblocks,nzblyr)) do n = n3Dzcum+1, n3Dbcum nn = n - n3Dzcum @@ -1127,7 +1100,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzblyr - workr3(:,:,j,i) = a3Db(:,:,i,nn,j) + workd3(:,:,j,i) = a3Db(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1135,13 +1108,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3db,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3db,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3db,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Db + deallocate(workd3) deallocate(workr3) ! 3D (vertical snow biology) + allocate(workd3(nx_block,ny_block,nblocks,nzalyr)) allocate(workr3(nx_block,ny_block,nblocks,nzalyr)) do n = n3Dbcum+1, n3Dacum nn = n - n3Dbcum @@ -1151,7 +1132,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nzalyr - workr3(:,:,j,i) = a3Da(:,:,i,nn,j) + workd3(:,:,j,i) = a3Da(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1159,13 +1140,21 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3da,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3da,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3da,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Db + deallocate(workd3) deallocate(workr3) ! 3D (fsd) + allocate(workd3(nx_block,ny_block,nblocks,nfsd_hist)) allocate(workr3(nx_block,ny_block,nblocks,nfsd_hist)) do n = n3Dacum+1, n3Dfcum nn = n - n3Dacum @@ -1175,7 +1164,7 @@ subroutine ice_write_hist (ns) 'ERROR: getting varid for '//avail_hist_fields(n)%vname) do j = 1, nblocks do i = 1, nfsd_hist - workr3(:,:,j,i) = a3Df(:,:,i,nn,j) + workd3(:,:,j,i) = a3Df(:,:,i,nn,j) enddo enddo #ifdef CESM1_PIO @@ -1183,12 +1172,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc3df,& - workr3, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc3df,& + workd3, status, fillval=spval_dbl) + else + workr3 = workd3 + call pio_write_darray(File, varid, iodesc3df,& + workr3, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_3Df + deallocate(workd3) deallocate(workr3) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nzilyr)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzilyr)) ! 4D (categories, fsd) do n = n3Dfcum+1, n4Dicum @@ -1200,7 +1197,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzilyr - workr4(:,:,j,i,k) = a4Di(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Di(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1209,12 +1206,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4di,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4di,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4di,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Di + deallocate(workd4) deallocate(workr4) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nzslyr)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nzslyr)) ! 4D (categories, vertical ice) do n = n4Dicum+1, n4Dscum @@ -1226,7 +1231,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nzslyr - workr4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Ds(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1235,12 +1240,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4ds,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4ds,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4ds,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Ds + deallocate(workd4) deallocate(workr4) + allocate(workd4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) allocate(workr4(nx_block,ny_block,nblocks,ncat_hist,nfsd_hist)) ! 4D (categories, vertical ice) do n = n4Dscum+1, n4Dfcum @@ -1252,7 +1265,7 @@ subroutine ice_write_hist (ns) do j = 1, nblocks do i = 1, ncat_hist do k = 1, nfsd_hist - workr4(:,:,j,i,k) = a4Df(:,:,k,i,nn,j) + workd4(:,:,j,i,k) = a4Df(:,:,k,i,nn,j) enddo ! k enddo ! i enddo ! j @@ -1261,13 +1274,20 @@ subroutine ice_write_hist (ns) #else call pio_setframe(File, varid, int(1,kind=PIO_OFFSET_KIND)) #endif - call pio_write_darray(File, varid, iodesc4df,& - workr4, status, fillval=spval_dbl) + if (history_precision == 8) then + call pio_write_darray(File, varid, iodesc4df,& + workd4, status, fillval=spval_dbl) + else + workr4 = workd4 + call pio_write_darray(File, varid, iodesc4df,& + workr4, status, fillval=spval) + endif endif enddo ! num_avail_hist_fields_4Df + deallocate(workd4) deallocate(workr4) -! similarly for num_avail_hist_fields_4Db (define workr4b, iodesc4db) +! similarly for num_avail_hist_fields_4Db (define workd4b, iodesc4db) !----------------------------------------------------------------- @@ -1297,6 +1317,34 @@ subroutine ice_write_hist (ns) end subroutine ice_write_hist +!======================================================================= + + subroutine ice_write_hist_fill(File,varid,vname,precision) + + use ice_kinds_mod + use ice_pio + use pio + + type(file_desc_t) , intent(inout) :: File + type(var_desc_t) , intent(in) :: varid + character(len=*), intent(in) :: vname ! var name + integer (kind=int_kind), intent(in) :: precision ! precision + + ! local variables + + integer (kind=int_kind) :: status + character(len=*), parameter :: subname = '(ice_write_hist_fill)' + + if (precision == 8) then + status = pio_put_att(File, varid, 'missing_value', spval_dbl) + status = pio_put_att(File, varid,'_FillValue',spval_dbl) + else + status = pio_put_att(File, varid, 'missing_value', spval) + status = pio_put_att(File, varid,'_FillValue',spval) + endif + + end subroutine ice_write_hist_fill + !======================================================================= end module ice_history_write diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 index 9c65b2ce1..d4149f7bf 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_pio.F90 @@ -197,9 +197,10 @@ end subroutine ice_pio_init !================================================================================ - subroutine ice_pio_initdecomp_2d(iodesc) + subroutine ice_pio_initdecomp_2d(iodesc, precision) type(io_desc_t), intent(out) :: iodesc + integer(kind=int_kind), optional, intent(in) :: precision integer (kind=int_kind) :: & iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k @@ -207,8 +208,12 @@ subroutine ice_pio_initdecomp_2d(iodesc) type(block) :: this_block integer(kind=int_kind), pointer :: dof2d(:) + integer(kind=int_kind) :: lprecision character(len=*), parameter :: subname = '(ice_pio_initdecomp_2d)' + lprecision = 8 + if (present(precision)) lprecision = precision + allocate(dof2d(nx_block*ny_block*nblocks)) n=0 @@ -235,8 +240,13 @@ subroutine ice_pio_initdecomp_2d(iodesc) enddo !j end do - call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global/), & - dof2d, iodesc) + if (lprecision == 8) then + call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global/), & + dof2d, iodesc) + else + call pio_initdecomp(ice_pio_subsystem, pio_real, (/nx_global,ny_global/), & + dof2d, iodesc) + endif deallocate(dof2d) @@ -244,19 +254,24 @@ end subroutine ice_pio_initdecomp_2d !================================================================================ - subroutine ice_pio_initdecomp_3d (ndim3, iodesc, remap) + subroutine ice_pio_initdecomp_3d (ndim3, iodesc, remap, precision) integer(kind=int_kind), intent(in) :: ndim3 type(io_desc_t), intent(out) :: iodesc logical, optional :: remap + integer(kind=int_kind), optional, intent(in) :: precision integer (kind=int_kind) :: & iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k type(block) :: this_block logical :: lremap integer(kind=int_kind), pointer :: dof3d(:) + integer(kind=int_kind) :: lprecision character(len=*), parameter :: subname = '(ice_pio_initdecomp_2d)' + lprecision = 8 + if (present(precision)) lprecision = precision + allocate(dof3d(nx_block*ny_block*nblocks*ndim3)) lremap=.false. if (present(remap)) lremap=remap @@ -313,8 +328,13 @@ subroutine ice_pio_initdecomp_3d (ndim3, iodesc, remap) enddo !ndim3 endif - call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global,ndim3/), & - dof3d, iodesc) + if (lprecision == 8) then + call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global,ndim3/), & + dof3d, iodesc) + else + call pio_initdecomp(ice_pio_subsystem, pio_real, (/nx_global,ny_global,ndim3/), & + dof3d, iodesc) + endif deallocate(dof3d) @@ -322,11 +342,12 @@ end subroutine ice_pio_initdecomp_3d !================================================================================ - subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc) + subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc, precision) integer(kind=int_kind), intent(in) :: ndim3 logical, intent(in) :: inner_dim type(io_desc_t), intent(out) :: iodesc + integer(kind=int_kind), optional, intent(in) :: precision integer (kind=int_kind) :: & iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k @@ -334,9 +355,12 @@ subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc) type(block) :: this_block integer(kind=int_kind), pointer :: dof3d(:) - + integer(kind=int_kind) :: lprecision character(len=*), parameter :: subname = '(ice_pio_initdecomp_3d_inner)' + lprecision = 8 + if (present(precision)) lprecision = precision + allocate(dof3d(nx_block*ny_block*nblocks*ndim3)) n=0 @@ -365,8 +389,13 @@ subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc) enddo !j end do !iblk - call pio_initdecomp(ice_pio_subsystem, pio_double, (/ndim3,nx_global,ny_global/), & - dof3d, iodesc) + if (lprecision == 8) then + call pio_initdecomp(ice_pio_subsystem, pio_double, (/ndim3,nx_global,ny_global/), & + dof3d, iodesc) + else + call pio_initdecomp(ice_pio_subsystem, pio_real, (/ndim3,nx_global,ny_global/), & + dof3d, iodesc) + endif deallocate(dof3d) @@ -374,10 +403,11 @@ end subroutine ice_pio_initdecomp_3d_inner !================================================================================ - subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc) + subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc, precision) integer(kind=int_kind), intent(in) :: ndim3, ndim4 type(io_desc_t), intent(out) :: iodesc + integer(kind=int_kind), optional, intent(in) :: precision integer (kind=int_kind) :: & iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k,l @@ -385,9 +415,12 @@ subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc) type(block) :: this_block integer(kind=int_kind), pointer :: dof4d(:) - + integer(kind=int_kind) :: lprecision character(len=*), parameter :: subname = '(ice_pio_initdecomp_4d)' + lprecision = 8 + if (present(precision)) lprecision = precision + allocate(dof4d(nx_block*ny_block*nblocks*ndim3*ndim4)) n=0 @@ -420,8 +453,13 @@ subroutine ice_pio_initdecomp_4d (ndim3, ndim4, iodesc) enddo !ndim3 enddo !ndim4 - call pio_initdecomp(ice_pio_subsystem, pio_double, & - (/nx_global,ny_global,ndim3,ndim4/), dof4d, iodesc) + if (lprecision == 8) then + call pio_initdecomp(ice_pio_subsystem, pio_double, & + (/nx_global,ny_global,ndim3,ndim4/), dof4d, iodesc) + else + call pio_initdecomp(ice_pio_subsystem, pio_real, & + (/nx_global,ny_global,ndim3,ndim4/), dof4d, iodesc) + endif deallocate(dof4d) diff --git a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 index 12d5d8e71..0ec6b7628 100644 --- a/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 +++ b/cicecore/cicedynB/infrastructure/io/io_pio2/ice_restart.F90 @@ -83,8 +83,8 @@ subroutine init_restart_read(ice_ic) File%fh=-1 call ice_pio_init(mode='read', filename=trim(filename), File=File, iotype=iotype) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true.) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat,remap=.true., precision=8) if (use_restart_time) then status1 = PIO_noerr @@ -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 @@ -638,8 +649,8 @@ subroutine init_restart_write(filename_spec) deallocate(dims) status = pio_enddef(File) - call ice_pio_initdecomp(iodesc=iodesc2d) - call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true.) + call ice_pio_initdecomp(iodesc=iodesc2d, precision=8) + call ice_pio_initdecomp(ndim3=ncat , iodesc=iodesc3d_ncat, remap=.true., precision=8) ! endif ! restart_format diff --git a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 index 62ff2727d..f8627d690 100644 --- a/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 +++ b/cicecore/drivers/nuopc/cmeps/ice_import_export.F90 @@ -582,7 +582,7 @@ subroutine ice_import( importState, rc ) rhoa(i,j,iblk) = inst_pres_height_lowest / & (287.058_ESMF_KIND_R8*(1._ESMF_KIND_R8+0.608_ESMF_KIND_R8*Qa(i,j,iblk))*Tair(i,j,iblk)) else - rhoa(i,j,iblk) = 0._ESMF_KIND_R8 + rhoa(i,j,iblk) = 1.2_ESMF_KIND_R8 endif end do !i end do !j 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/drivers/unittest/bcstchk/bcstchk.F90 b/cicecore/drivers/unittest/bcstchk/bcstchk.F90 index e5cadc805..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 @@ -257,36 +257,16 @@ 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 - ! 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 09a297f1f..d669dbad3 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 @@ -40,7 +41,7 @@ program calchk failflag = 'FAIL' write(6,*) ' ' - write(6,*) 'Running CALCHK' + write(6,*) 'RunningUnitTest CALCHK' write(6,*) ' ' errorflag0 = passflag @@ -54,6 +55,7 @@ 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 @@ -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 !------------------------- @@ -579,10 +601,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..c4e4ae91f 100644 --- a/cicecore/drivers/unittest/helloworld/helloworld.F90 +++ b/cicecore/drivers/unittest/helloworld/helloworld.F90 @@ -1,8 +1,9 @@ program hello_world - write(6,*) 'hello_world' - write(6,*) 'COMPLETED SUCCESSFULLY' + write(6,*) 'RunningUnitTest hello_world' + 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..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 @@ -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/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_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/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/cicecore/version.txt b/cicecore/version.txt index cfd991555..04a90ef1a 100644 --- a/cicecore/version.txt +++ b/cicecore/version.txt @@ -1 +1 @@ -CICE 6.2.0 +CICE 6.3.0 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/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/ice_in b/configuration/scripts/ice_in index e918a694c..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. @@ -127,7 +129,7 @@ kdyn = 1 ndte = 240 revised_evp = .false. - kevp_kernel = 0 + evp_algorithm = 'standard_2d' brlx = 300.0 arlx = 300.0 advection = 'remap' @@ -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/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/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.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=" 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/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.gx1prod b/configuration/scripts/options/set_nml.gx1prod index eca527a64..94e4bbf89 100644 --- a/configuration/scripts/options/set_nml.gx1prod +++ b/configuration/scripts/options/set_nml.gx1prod @@ -1,11 +1,11 @@ year_init = 2005 use_leap_years = .true. npt_unit = 'y' -npt = 1 +npt = 4 dumpfreq = 'm' dumpfreq_base = 'zero' fyear_init = 2005 -ycycle = 5 +ycycle = 4 ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY/' use_bathymetry = .true. seabed_stress = .true. diff --git a/configuration/scripts/options/set_nml.gx1prod15 b/configuration/scripts/options/set_nml.gx1prod15 new file mode 100644 index 000000000..edbf5e5de --- /dev/null +++ b/configuration/scripts/options/set_nml.gx1prod15 @@ -0,0 +1,19 @@ +year_init = 1995 +use_leap_years = .true. +npt_unit = 'y' +npt = 15 +dumpfreq = 'm' +dumpfreq_base = 'zero' +fyear_init = 1995 +ycycle = 16 +ocn_data_dir = 'ICE_MACHINE_INPUTDATA/CICE_data/forcing/gx1/CESM/MONTHLY/' +use_bathymetry = .true. +seabed_stress = .true. +seabed_stress_method = 'LKD' +ocn_data_type = 'ncar' +ocn_data_format = 'nc' +oceanmixed_ice = .true. +oceanmixed_file = 'ocean_forcing_clim_2D_gx1.20210330.nc' +tr_brine = .true. +f_taubx = 'm' +f_tauby = 'm' 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/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/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/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/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/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 69252f9fb..4da4dd110 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 +restart gx1 40x4 droundrobin,medium +restart tx1 40x4 dsectrobin,medium restart gx3 4x4 none restart gx3 10x4 maskhalo restart gx3 6x2 alt01 @@ -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/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/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/configuration/scripts/tests/prod_suite.ts b/configuration/scripts/tests/prod_suite.ts new file mode 100644 index 000000000..8793dfed2 --- /dev/null +++ b/configuration/scripts/tests/prod_suite.ts @@ -0,0 +1,4 @@ +# Test Grid PEs Sets BFB-compare +smoke gx1 64x1 qc,medium +smoke gx1 64x2 gx1prod,long,run10year + 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 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/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/conf.py b/doc/source/conf.py index 4cf2f580d..099f65403 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'6.2.0' +version = u'6.3.0' # The full version, including alpha/beta/rc tags. -version = u'6.2.0' +version = u'6.3.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. 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/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/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/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: Fri, 1 Oct 2021 09:42:49 -0400 Subject: [PATCH 42/44] Use CICE-Consortium/Icepack master (#40) * switch to icepack master at consortium --- .gitmodules | 5 +++-- icepack | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 8a773d230..1868e25dc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,4 @@ [submodule "icepack"] - path = icepack - url = https://github.com/NOAA-EMC/Icepack + path = icepack + url = https://github.com/CICE-Consortium/Icepack + branch = master diff --git a/icepack b/icepack index 29ee0cefc..34c8e688b 160000 --- a/icepack +++ b/icepack @@ -1 +1 @@ -Subproject commit 29ee0cefc35b6d6b00f3f0fd11cb9a1877f20fa6 +Subproject commit 34c8e688bf7f3008cf84093cd703cf8cfe068eda From 8d4a3c626f65e73f20efaeb4d8b7fc5e0771983a Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 22 Nov 2021 09:06:56 -0500 Subject: [PATCH 43/44] recreate cap update branch (#42) * add debug_model feature * add required variables and calls for tr_snow --- cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 | 49 +++++++++--- cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 | 80 +++++++++++++++++-- 2 files changed, 113 insertions(+), 16 deletions(-) diff --git a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 index cfca994c3..8b69730b8 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_InitMod.F90 @@ -8,6 +8,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 @@ -83,7 +84,7 @@ subroutine cice_init2() use ice_dyn_vp , only: init_vp use ice_flux , only: init_coupler_flux, init_history_therm use ice_flux , only: init_history_dyn, init_flux_atm, init_flux_ocn - use ice_forcing , only: init_forcing_ocn + use ice_forcing , only: init_forcing_ocn, init_snowtable use ice_forcing_bgc , only: get_forcing_bgc, get_atm_bgc use ice_forcing_bgc , only: faero_default, faero_optics, alloc_forcing_bgc, fiso_default use ice_history , only: init_hist, accum_hist @@ -95,7 +96,8 @@ subroutine cice_init2() use ice_transport_driver , only: init_transport logical(kind=log_kind) :: tr_aero, tr_zaero, skl_bgc, z_tracers - logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec + logical(kind=log_kind) :: tr_iso, tr_fsd, wave_spec, tr_snow + character(len=char_len) :: snw_aging_table character(len=*), parameter :: subname = '(cice_init2)' !---------------------------------------------------- @@ -145,7 +147,7 @@ subroutine cice_init2() 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__) @@ -158,7 +160,7 @@ subroutine cice_init2() call init_history_dyn ! initialize dynamic history variables 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__) @@ -167,6 +169,17 @@ subroutine cice_init2() call faero_optics !initialize aerosol optical property tables end if + ! 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 + ! Initialize shortwave components using swdn from previous timestep ! if restarting. These components will be scaled to current forcing ! in prep_radiation. @@ -199,12 +212,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, & @@ -212,6 +225,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, & @@ -226,12 +240,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_fsd, tr_iso, tr_aero, tr_brine, tr_snow, & 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)' @@ -247,10 +262,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, & @@ -347,6 +364,21 @@ 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. @@ -441,7 +473,6 @@ subroutine init_restart() call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) - end subroutine init_restart !======================================================================= diff --git a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 index 81fa367c1..219777f6f 100644 --- a/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 +++ b/cicecore/drivers/nuopc/cmeps/CICE_RunMod.F90 @@ -110,7 +110,7 @@ subroutine ice_step use ice_boundary, only: ice_HaloUpdate use ice_calendar, only: dt, dt_dyn, ndtd, diagfreq, write_restart, istep use ice_calendar, only: idate, msec - use ice_diagnostics, only: init_mass_diags, runtime_diags + use ice_diagnostics, only: init_mass_diags, runtime_diags, debug_model, debug_ice use ice_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use ice_domain, only: halo_info, nblocks use ice_dyn_eap, only: write_restart_eap @@ -123,12 +123,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 @@ -144,19 +145,28 @@ 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 character(len=*), parameter :: subname = '(ice_step)' + character (len=char_len) :: plabeld + + if (debug_model) then + plabeld = 'beginning time step' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, skl_bgc_out=skl_bgc, & solve_zsal_out=solve_zsal, z_tracers_out=z_tracers, ktherm_out=ktherm, & wave_spec_out=wave_spec) call icepack_query_tracer_flags(tr_iage_out=tr_iage, tr_FY_out=tr_FY, & tr_lvl_out=tr_lvl, tr_pond_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__) @@ -201,15 +211,33 @@ subroutine ice_step !----------------------------------------------------------------- if (calc_Tsfc) call prep_radiation (iblk) + if (debug_model) then + plabeld = 'post prep_radiation' + call debug_ice (iblk, plabeld) + endif !----------------------------------------------------------------- ! thermodynamics and biogeochemistry !----------------------------------------------------------------- call step_therm1 (dt, iblk) ! vertical thermodynamics + if (debug_model) then + plabeld = 'post step_therm1' + call debug_ice (iblk, plabeld) + endif + call biogeochemistry (dt, iblk) ! biogeochemistry + if (debug_model) then + plabeld = 'post biogeochemistry' + call debug_ice (iblk, plabeld) + endif + if (.not.prescribed_ice) & call step_therm2 (dt, iblk) ! ice thickness distribution thermo + if (debug_model) then + plabeld = 'post step_therm2' + call debug_ice (iblk, plabeld) + endif endif ! ktherm > 0 @@ -237,6 +265,12 @@ subroutine ice_step ! momentum, stress, transport call step_dyn_horiz (dt_dyn) + if (debug_model) then + plabeld = 'post step_dyn_horiz' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif ! ridging !$OMP PARALLEL DO PRIVATE(iblk) @@ -244,12 +278,24 @@ subroutine ice_step if (kridge > 0) call step_dyn_ridge (dt_dyn, ndtd, iblk) enddo !$OMP END PARALLEL DO + if (debug_model) then + plabeld = 'post step_dyn_ridge' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo ! iblk + endif ! clean up, update tendency diagnostics offset = c0 call update_state (dt_dyn, daidtd, dvidtd, dagedtd, offset) enddo + if (debug_model) then + plabeld = 'post dynamics' + do iblk = 1, nblocks + call debug_ice (iblk, plabeld) + enddo + endif endif ! not prescribed ice @@ -260,18 +306,36 @@ subroutine ice_step call ice_timer_start(timer_column) ! column physics call ice_timer_start(timer_thermo) ! thermodynamics + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then ! advanced snow physics + 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 if (ktherm >= 0) call step_radiation (dt, iblk) + if (debug_model) then + plabeld = 'post step_radiation' + call debug_ice (iblk, plabeld) + endif !----------------------------------------------------------------- ! get ready for coupling and the next time step !----------------------------------------------------------------- call coupling_prep (iblk) - + if (debug_model) then + plabeld = 'post coupling_prep' + call debug_ice (iblk, plabeld) + endif enddo ! iblk !$OMP END PARALLEL DO @@ -309,6 +373,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 @@ -634,11 +699,12 @@ subroutine sfcflux_to_ocn(nx_block, ny_block, & real (kind=dbl_kind) :: & puny, & ! + Lsub, & ! rLsub ! 1/Lsub character(len=*), parameter :: subname = '(sfcflux_to_ocn)' - call icepack_query_parameters(puny_out=puny) + call icepack_query_parameters(puny_out=puny, Lsub_out=Lsub) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call abort_ice(error_message=subname, & file=__FILE__, line=__LINE__) From fb216b66a160973e3d01766ab4ce1c2076f37995 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 26 Nov 2021 10:26:24 -0500 Subject: [PATCH 44/44] remove ITDrdg nml file --- configuration/scripts/options/set_nml.snwITDrdg | 10 ---------- 1 file changed, 10 deletions(-) delete mode 100644 configuration/scripts/options/set_nml.snwITDrdg diff --git a/configuration/scripts/options/set_nml.snwITDrdg b/configuration/scripts/options/set_nml.snwITDrdg deleted file mode 100644 index cddeedec3..000000000 --- a/configuration/scripts/options/set_nml.snwITDrdg +++ /dev/null @@ -1,10 +0,0 @@ -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 -