p_sanity_check.f90 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040
  1. # 0 "<stdin>"
  2. # 0 "<built-in>"
  3. # 0 "<command-line>"
  4. # 1 "/usr/include/stdc-predef.h" 1 3 4
  5. # 17 "/usr/include/stdc-predef.h" 3 4
  6. # 2 "<command-line>" 2
  7. # 1 "<stdin>"
  8. PROGRAM sanity_check_LIM3
  9. ! Checks if a LIM3 restart is physically consistent and outputs the updated
  10. ! version. Strongly based on limupdate.F90, and on sanity_check_LIM2
  11. ! (c) Original from Chris König Beatty
  12. ! (c) Re-written by Francois Massonnet, November 2012,
  13. ! (c) Refreshed for NEMO3.6, Francois Massonnet, April 2016
  14. ! francois.massonnet@uclouvain.be
  15. !
  16. !
  17. ! TODO: create subroutines to automaticate the extraction of NetCDF!
  18. ! **************************************************************************************************
  19. ! PLAN of the program
  20. !
  21. !
  22. ! 0. Header
  23. ! 1. Check existence of NetCDF files, grab command line args
  24. ! 1) Ice analysis file
  25. ! 2) Ice forecast file
  26. ! 3) Oce analysis file
  27. ! 4) Oce forecast file
  28. ! 5) Mask file
  29. ! 6) Mesh file
  30. ! 2. Get dimensions, nb ice categories, nb ice/snow layers, allocate, get ice thickness bounds
  31. ! 3. Load ice+oce and mask+mesh variables from files
  32. ! 4. Ice analysis sanity check
  33. ! 1) Regularize ice concentration and adapt other variables
  34. ! accordingly
  35. ! 2) Manually update the snow and ice heat content according to volume
  36. ! changes
  37. ! 3) Rebin categories with thickness out of bounds (CALL itd_reb() )
  38. ! Note that itd_reb() calls shift_ice if a shift needs be done
  39. ! 4) Several ice corrections
  40. ! For example, set volume to zero where concentration is zero.
  41. ! 5) Shrink ice (CALL shrink_ice() )
  42. ! If sum(a_i) > 1 or < 0 or some a_i > 1 or < 0, then ice is shrunk
  43. ! or reset to zero.
  44. ! 6) Rebin categories with thickness out of bounds (CALL itd_reb() )
  45. ! We do it once again as thickness may have changed
  46. ! during processes 2) and 3)
  47. ! 7) Final concentration check (CALL conc_check() )
  48. ! The program stops if > 1 or < 0 occurs in sum or individual categories
  49. ! This can ultimately cause trouble in the code as a term (1-sum(a_i))^0.6
  50. ! occurs in a routine => negative power 0.6 is very baaaad
  51. ! If ice concentration is just above 1 or just below zero (numerics) then
  52. ! the program resets to zero or one.
  53. ! 5. Oce analysis sanity check
  54. ! 1) Compute the difference between forecast and analyzed sea salinity
  55. ! If larger than XXX PSU, bound variations by that value
  56. ! Also update the sea surface salinity variable accordingly
  57. ! 2) Same for sea temperature; replace analysed temperature by forecast if
  58. ! less than -2°C
  59. ! 3) Limit ocean velocities to [-2,2] m/s
  60. ! 6. Record the files. The original file is copied and the variables are dumped
  61. ! in it
  62. ! 1) Ice analysis file
  63. ! 2) Oce analysis file
  64. !***************************************************************************************************
  65. !
  66. ! 0. Header
  67. ! ---------
  68. USE netcdf
  69. USE my_variables
  70. IMPLICIT NONE
  71. ! Dummy variables
  72. INTEGER :: jl, ji, jj, jk
  73. !
  74. ! 1. Grab Command Line Arguments
  75. ! ------------------------------
  76. IF (iargc()==4) THEN
  77. CALL getarg(1, cfile_analysis_ice)
  78. CALL getarg(2, cfile_forecast_ice)
  79. CALL getarg(3, cfile_analysis_oce)
  80. CALL getarg(4, cfile_forecast_oce)
  81. ! Check if files exist
  82. ! 1) Ice analysis file
  83. INQUIRE(FILE=TRIM(cfile_analysis_ice), EXIST=l_ex)
  84. IF ( .NOT. l_ex ) THEN
  85. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  86. &TRIM(cfile_analysis_ice)
  87. STOP
  88. END IF
  89. ! 2) Ice forecast file
  90. INQUIRE(FILE=TRIM(cfile_forecast_ice), EXIST=l_ex)
  91. IF ( .NOT. l_ex ) THEN
  92. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  93. &TRIM(cfile_forecast_ice)
  94. STOP
  95. END IF
  96. ! 3) Oce analysis file
  97. INQUIRE(FILE=TRIM(cfile_analysis_oce), EXIST=l_ex)
  98. IF ( .NOT. l_ex ) THEN
  99. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  100. &TRIM(cfile_analysis_oce)
  101. STOP
  102. END IF
  103. ! 4) Oce forecast file
  104. INQUIRE(FILE=TRIM(cfile_forecast_oce), EXIST=l_ex)
  105. IF ( .NOT. l_ex ) THEN
  106. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  107. &TRIM(cfile_forecast_oce)
  108. STOP
  109. END IF
  110. ! 5) Mask file
  111. INQUIRE(FILE=TRIM(cmaskfile), EXIST=l_ex)
  112. IF ( .NOT. l_ex ) THEN
  113. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  114. &TRIM(cmaskfile)
  115. STOP
  116. END IF
  117. ! 6) Mesh file
  118. INQUIRE(FILE=TRIM(cmeshfile), EXIST=l_ex)
  119. IF ( .NOT. l_ex ) THEN
  120. WRITE(*,*) "(sanity_check_lim3) File does not exist: " //&
  121. &TRIM(cmeshfile)
  122. STOP
  123. END IF
  124. ! Everything went OK:
  125. WRITE(*,*) "(sanity_check_lim3) Starting ..."
  126. ELSE
  127. ! Write info
  128. WRITE(*,*)
  129. WRITE(*,*) " sanity_check_LIM3 needs arguments: "
  130. WRITE(*,*) " -analysis_file_ice "
  131. WRITE(*,*) " -forecast_file_ice "
  132. WRITE(*,*) " -analysis_file_oce "
  133. WRITE(*,*) " -forecast_file_oce "
  134. WRITE(*,*) " Checks NEMO-LIM3 ice and ocean analyses restarst (netcdf) file for sanity and fixes&
  135. &them if necessary."
  136. WRITE(*,*)
  137. WRITE(*,*) " Sanity means for now:"
  138. WRITE(*,*) " Strongly follow limupdate.F90"
  139. WRITE(*,*) " Files mask.nc and mesh_hgr.nc need to be in the current directory"
  140. WRITE(*,*)
  141. WRITE(*,*) " Hope to see you again soon."
  142. WRITE(*,*)
  143. WRITE(*,*) " Chris König Beatty "
  144. WRITE(*,*) " Francois Massonnet -- francois.massonnet@uclouvain.be"
  145. WRITE(*,*) " Last update: 2013"
  146. WRITE(*,*) " Last update: 2016 (to work with NEMO3.6)"
  147. STOP "(sanity_check): Stopped."
  148. END IF ! iargc
  149. ! 2. Get dimensions, and allocate the variables
  150. ! ---------------------------------------------
  151. CALL get_dimensions()
  152. ! Get number of ice categories
  153. CALL get_nb_cat()
  154. ! Get number of ice layers
  155. CALL get_nb_il()
  156. ! Get number of snow layers
  157. CALL get_nb_sl()
  158. ! Allocate variables
  159. CALL allocate_variables()
  160. ! Register ice thickness limits
  161. ! See Clement Rousset LIM3 paper or LIM3 doc:
  162. ! http://www.geosci-model-dev.net/8/2991/2015/gmd-8-2991-2015.pdf
  163. ! or the routine sbcice_lim.F90
  164. !
  165. !
  166. !
  167. !
  168. zalpha = 0.05 ! exponent of the transform function
  169. rn_himean = 2.0 ! the expected mean thickness over the domain
  170. zhmax = 3.*rn_himean
  171. DO jl = 1, jpl
  172. znum = jpl * ( zhmax+1 )**zalpha
  173. zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl
  174. hi_max(jl) = ( znum / zden )**(1./zalpha) - 1
  175. END DO
  176. ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl)
  177. hi_max(jpl) = 99._wp
  178. WRITE(*,*), "Ice categories boundaries [m] are", hi_max
  179. ! 3. Load variables
  180. ! -----------------
  181. CALL load_variables()
  182. WRITE(*,*), "babysit after load_variables:"
  183. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  184. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  185. !IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  186. ! WRITE(*,*) 'Res shrink jl1:' , e_s(ji,jj,jk,jl1)
  187. ! WRITE(*,*) 'Res shrink jl2:' , e_s(ji,jj,jk,jl2)
  188. ! END IF
  189. WRITE(*,*), " "
  190. ! 4. Ice analysis sanity check
  191. ! ----------------------------
  192. ! 1) Regularize ice concentration and other variables based on that
  193. CALL regularize()
  194. WRITE(*,*), "babysit after regularize:"
  195. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  196. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  197. WRITE(*,*), " "
  198. ! 2) Heat content update
  199. ! F. Massonnet - test CALL update_hc()
  200. ! CALL update_hc()
  201. ! 3) Rebin categories with thickness out of bounds
  202. ! The code here follows closely the contents of subroutine limi_itd_th_reb
  203. CALL itd_reb()
  204. WRITE(*,*), "babysit after itd_reb #1:"
  205. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  206. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  207. WRITE(*,*), " "
  208. ! 4) Several ice corrections
  209. CALL several_ice_corrections()
  210. WRITE(*,*), "babysit several ice corrections:"
  211. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  212. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  213. WRITE(*,*), " "
  214. ! 5) Shrink ice
  215. CALL shrink_ice()
  216. WRITE(*,*), "babysit after shrink_ice:"
  217. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  218. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  219. WRITE(*,*), " "
  220. ! 6) Rebin categories with thickness out of bounds
  221. CALL itd_reb()
  222. WRITE(*,*), "babysit after itd_reb #2:"
  223. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  224. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  225. WRITE(*,*), " "
  226. ! 7) Final check.
  227. ! Stops if total conc > 1 or < 0, same for inidividual conc
  228. ! If exceeds 1 or is below zero for numerical reasons, reset.
  229. CALL conc_check()
  230. WRITE(*,*), "babysit after conc check:"
  231. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  232. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,1,2)
  233. WRITE(*,*), " "
  234. ! 5. Ocean analysis sanity check
  235. ! ------------------------------
  236. ! 1) Salinity
  237. CALL salinity_check()
  238. ! 2) Temperature
  239. CALL temperature_check()
  240. ! 3) Velocity
  241. CALL velocity_check()
  242. ! 6. Record NetCDF
  243. ! ----------------
  244. ! 1) Ice variables
  245. CALL record_ice()
  246. WRITE(*,*), "babysit after record ice:"
  247. WRITE(*,*), "e_s_l01 i j", e_s(jiindx,jjindx,1,1)
  248. WRITE(*,*), "e_s_l02 i j", e_s(jiindx,jjindx,2,1)
  249. WRITE(*,*), "found negative val"
  250. DO jk = 1, nlay_s
  251. DO jl = 1, jpl
  252. DO ji = 1, jpi
  253. DO jj = 1 , jpj
  254. IF ( e_s(ji,jj,jl,jk) < rzero ) THEN
  255. WRITE(*,*), "e_s < 0.0 in i=",ji," j=",jj
  256. ENDIF
  257. END DO ! jj
  258. END DO ! ji
  259. END DO ! jl
  260. END DO ! jk
  261. ! 2) Oce variables
  262. CALL record_oce()
  263. END PROGRAM sanity_check_LIM3
  264. ! SUBROUTINES
  265. ! ¨¨¨¨¨¨¨¨¨¨¨
  266. SUBROUTINE itd_reb()
  267. ! --------------------------------------------------------
  268. ! This routine is strongly inspired from lim_itd_th_reb
  269. ! When in situ thickness exceeds bounds, it transfers ice
  270. ! to neighbouring categories
  271. ! This routine calls shiftice() defined below
  272. ! --------------------------------------------------------
  273. USE my_variables
  274. IMPLICIT NONE
  275. ! Dummy variables
  276. INTEGER :: ji, jj, jl
  277. WRITE(*,*) 'Entering itd_reb()'
  278. ! 4.2.1 Compute in situ ice thickness in the categories (if there's ice)
  279. DO jl = 1, jpl
  280. DO ji = 1, jpi
  281. DO jj = 1 , jpj
  282. IF ( a_i(ji,jj,jl) > epsi10 ) THEN
  283. ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
  284. ELSE
  285. ht_i(ji,jj,jl) = rzero
  286. ENDIF
  287. END DO ! jj
  288. END DO ! ji
  289. END DO ! jl
  290. ! Print data at particular location before rebinning
  291. !WRITE(*,*) 'Before rebinning: '
  292. !WRITE(*,*) 'a_i : ',a_i(jiindx,jjindx,:)
  293. !WRITE(*,*) 'ht_i : ',ht_i(jiindx,jjindx,:)
  294. !WRITE(*,*) 'Total concentration: ', SUM(a_i(jiindx,jjindx,:))
  295. !WRITE(*,*) 'Total volume : ', SUM(v_i(jiindx,jjindx,:))
  296. ! 4.2.2 Make sure thickness of first category is at least hi_max_typ
  297. ! Not sure to understand what to do here
  298. ! 4.2.3. If a category is not in bounds, shift the entire area, volume and
  299. ! energy to the neighbouring category
  300. ! Initialize shift arrays
  301. DO jl = 1, jpl
  302. idonor(:,:,jl) = 0
  303. ! idonor is the index of the category that is giving ice with respect to
  304. ! the running category.
  305. ! Example: we are looping over categories. When jl = 3 (third category),
  306. ! we notice that this category has way too much ice. Then idonor(ji,jj,3)
  307. ! will be 3. Example 2 (jl=3): The fourth category has too much ice
  308. ! Then idonor(ji,jj,3) = 4
  309. zdaice(:,:,jl) = 0
  310. zdvice(:,:,jl) = 0
  311. END DO
  312. ! 4.2.3.1 Move thin categories up
  313. ! Strategy: -loop over all categories up to the last-but-one
  314. ! -identify thicknesses in the current category that are too big
  315. ! -if applicable, transfer all volume, area and energy to the
  316. ! jpl + 1 category
  317. DO jl = 1, jpl - 1
  318. zshiftflag = 0
  319. DO ji = 1, jpi
  320. DO jj= 1, jpj
  321. IF ( a_i(ji,jj,jl) > epsi10 .AND. ht_i(ji,jj,jl) > hi_max(jl) ) THEN
  322. IF ( ldebug ) THEN
  323. WRITE(*,*), "Found excessive ice thickness in category",jl
  324. WRITE(*,*), ht_i(ji,jj,jl), "larger than" , hi_max(jl)
  325. WRITE(*,*), "At grid point" , ji, jj
  326. END IF
  327. zshiftflag = 1 ! There's at least one point in the domain
  328. ! with too thick a sea ice in this category
  329. idonor(ji,jj,jl) = jl ! The running category is then donor
  330. zdaice(ji,jj,jl) = a_i(ji,jj,jl) ! Amount of ice to be transferred
  331. zdvice(ji,jj,jl) = v_i(ji,jj,jl) ! (everything)
  332. END IF
  333. END DO! jj
  334. END DO ! ji
  335. IF (zshiftflag == 1) THEN ! this is the case if there was at least one
  336. ! excessive thickness in the running category
  337. ! somewhere on the domain
  338. CALL shiftice()
  339. idonor(:,:,jl) = 0 ! Reset before we move to next category
  340. zdaice(:,:,jl) = rzero
  341. zdvice(:,:,jl) = rzero
  342. END IF
  343. END DO ! jl, categories
  344. ! 4.2.3.2 Move thick categories down
  345. ! Strategy: -loop over all categories starting from last-but-one
  346. ! to the first one
  347. ! -identify if the thickness of the category above is smaller
  348. ! than the upper limit for the running category
  349. ! -if so, transfer everything to the running category
  350. DO jl = jpl-1, 1, -1 ! first, last, step
  351. zshiftflag = 0
  352. DO ji = 1, jpi
  353. DO jj= 1, jpj
  354. IF ( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN
  355. IF ( ldebug ) THEN
  356. WRITE(*,*), "Found too small ice thickness in category",jl+1
  357. WRITE(*,*), ht_i(ji,jj,jl+1), "smaller than" , hi_max(jl)
  358. END IF
  359. zshiftflag = 1 ! There's at least one point in the domain
  360. ! with too thin a sea ice in this category
  361. idonor(ji,jj,jl) = jl+1 ! The jl+1 category is then donor
  362. zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) ! Amount of ice to be transferred
  363. zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) ! (everything)
  364. END IF
  365. END DO! jj
  366. END DO ! ji
  367. IF (zshiftflag == 1) THEN ! this is the case if there was at least one
  368. ! too small thickness in the jl+1 category
  369. CALL shiftice()
  370. idonor(:,:,jl) = rzero ! Reset before we move to next category
  371. zdaice(:,:,jl) = rzero
  372. zdvice(:,:,jl) = rzero
  373. END IF
  374. END DO ! jl, categories
  375. ! 4.2.3.3 Conservation check
  376. ! Print data at particular location after rebinning
  377. !WRITE(*,*) 'After rebinning: '
  378. !WRITE(*,*) 'a_i : ',a_i(jiindx,jjindx,:)
  379. !WRITE(*,*) 'ht_i : ',ht_i(jiindx,jjindx,:)
  380. !WRITE(*,*) 'Total concentration: ', SUM(a_i(jiindx,jjindx,:))
  381. !WRITE(*,*) 'Total volume : ', SUM(v_i(jiindx,jjindx,:))
  382. WRITE(*,*) 'Leaving itd_reb()'
  383. END SUBROUTINE itd_reb
  384. SUBROUTINE shiftice()
  385. !-------------------------------------------------------------
  386. ! This routine is (strongly) inspired by lim_itd_shiftice
  387. ! It re-arranges ice thickness in the categories
  388. !
  389. ! This routine can potentially be called 2*4 times,
  390. ! for the first jpl-1 categories to upgrade their too thick ice
  391. ! and for the jpl-1 last categories to downgrade their too thin ice
  392. !
  393. !
  394. ! Francois Massonnet UCL 2012 francois.massonnet@uclouvain.be
  395. !-------------------------------------------------------------
  396. ! Variable declaration and importation
  397. USE my_variables
  398. IMPLICIT NONE
  399. LOGICAL :: zdaice_negative, zdvice_negative, zdaice_greater_aicen,&
  400. &zdvice_greater_vicen
  401. ! Number of cells with ice to transfer
  402. REAL(wp), DIMENSION(jpi,jpj) :: zworka
  403. REAL(wp), DIMENSION(jpi,jpj,jpl) :: zaTsfn
  404. REAL(wp) :: zdvsnow, zdesnow, zdo_aice
  405. ! Volume of snow transferred,
  406. ! Snow heat, ice age
  407. ! local variables
  408. REAL(wp) :: zdsm_vice, zdaTsf, zdeice
  409. ! ice age, surface temperature,
  410. ! ice heat content
  411. ! local variables
  412. ! Dummy variables
  413. INTEGER :: ji, jj, jl, jk, jl1, jl2
  414. ! End definitions
  415. ! ----------------------------------------------------------------------
  416. ! Welcome the user
  417. WRITE(*,*) 'Entering SUBROUTINE shiftice'
  418. ! Define surface temperature times concentration
  419. ! This has more dimensions like energy. It will be used
  420. ! when surface temperature will be "transferred" after rebinning
  421. DO jl = 1 , jpl
  422. zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl)
  423. END DO
  424. ! Subroutine
  425. DO jl = 1 , jpl - 1
  426. zdaice_negative = .FALSE.
  427. zdvice_negative = .FALSE.
  428. zdaice_greater_aicen = .FALSE.
  429. zdvice_greater_vicen = .FALSE.
  430. DO ji = 1 , jpi
  431. DO jj = 1 , jpj
  432. !---------------------------------------------------------------------
  433. ! 1) Check for daice or dvice out of bounds and reset if necessary
  434. !---------------------------------------------------------------------
  435. IF ( idonor(ji,jj,jl) .GT. 0 ) THEN ! If the running category is giving
  436. jl1=idonor(ji,jj,jl) ! record the donor category
  437. !WRITE(*,*), "At grid point ", ji, jj, "category", jl1, "is giving ice"
  438. ! Tackle the cases with problems. Normally, zdaice and zdvice should
  439. ! be positive, but ...
  440. ! Check for negative transfers of ice given in input
  441. ! 1. Ice area
  442. IF (zdaice(ji,jj,jl) .LT. rzero ) THEN
  443. IF (zdaice(ji,jj,jl) .GT. -epsi10 ) THEN
  444. WRITE(*,*)," zdaice is negative but artificial"
  445. IF ( ( jl1 .EQ. jl .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )&
  446. &.OR.&
  447. &( jl1 .EQ. jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )) THEN
  448. ! You are here if one of these 2 conditions are verified
  449. ! 1) The running category is the donor and has too thick a
  450. ! sea ice
  451. ! 2) The running category is one category below the donor,
  452. ! which has too thin a sea ice
  453. !
  454. ! If you still with me, it means that a transfer needs to be
  455. ! done but the amount of ice is negative due to roundoff
  456. ! error or something. Let us reset zdaice and zdvice to the
  457. ! value of a_i and v_i in the category for the transfer
  458. zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
  459. zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
  460. ELSE ! None of the two conditions above is verified
  461. ! That is,
  462. ! 1) The running category is not the donor or has a correct
  463. ! ice
  464. ! AND
  465. ! 2) The category above the running one is not the donor, or
  466. ! the ice is correct in this above category
  467. !
  468. ! Since everything is fine, nothing should be done
  469. zdaice(ji,jj,jl) = rzero
  470. zdvice(ji,jj,jl) = rzero
  471. END IF
  472. ELSE ! zdaice < - eps10
  473. WRITE(*,*) "zdaice is really negative"
  474. zdaice_negative = .TRUE.
  475. END IF
  476. END IF ! zdaice < 0
  477. ! 2. Repeat for ice volume
  478. IF (zdvice(ji,jj,jl) .LT. rzero ) THEN
  479. IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN
  480. WRITE(*,*)," zdvice is negative but artificial"
  481. IF ( ( jl1 .EQ. jl .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )&
  482. &.OR.&
  483. &( jl1 .EQ. jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )) THEN
  484. ! You are here if one of these 2 conditions are verified
  485. ! 1) The running category is the donor and has too thick a
  486. ! sea ice
  487. ! 2) The running category is one category below the donor,
  488. ! which has too thin a sea ice
  489. !
  490. ! If you still with me, it means that a transfer needs to be
  491. ! done but the amount of ice is negative due to roundoff
  492. ! error or something. Let us reset zdaice and zdvice to the
  493. ! value of a_i and v_i in the category for the transfer
  494. zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
  495. zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
  496. ELSE ! None of the two conditions above is verified
  497. ! That is,
  498. ! 1) The running category is not the donor or has a correct
  499. ! ice
  500. ! AND
  501. ! 2) The category above the running one is not the donor, or
  502. ! the ice is correct in this above category
  503. !
  504. ! Since everything is fine, nothing should be done
  505. zdaice(ji,jj,jl) = rzero
  506. zdvice(ji,jj,jl) = rzero
  507. END IF
  508. ELSE ! zdvice < - eps10
  509. WRITE(*,*) "zdvice is really negative"
  510. zdvice_negative = .TRUE.
  511. END IF
  512. END IF ! zdvice < 0
  513. ! 3.A. If the area to be transferred equals the area in the running
  514. ! category, then just update it to the exact value
  515. ! (i.e. round it )
  516. IF ( zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 .AND.&
  517. & zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1) + epsi10 ) THEN
  518. ! if concentration to be transferred is "equal"
  519. ! to the concentration of the donor. This is obviously the case
  520. ! if the running category is the donor
  521. zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
  522. zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
  523. ELSE
  524. ! Otherwise, set the switch to true
  525. zdaice_greater_aicen = .TRUE.
  526. END IF ! zdaice "=" a_i
  527. ! 3.B. (Repeat for volume)
  528. ! If the volume to be transferred equals the volume in the running
  529. ! category, then keep it as is
  530. IF ( zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1) - epsi10 .AND.&
  531. & zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1) + epsi10 ) THEN
  532. ! if volume to be transferred is "equal"
  533. ! to the volume of the donor. This is obviously the case
  534. ! if the running category is the donor
  535. zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
  536. zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
  537. ELSE
  538. zdvice_greater_vicen = .TRUE.
  539. END IF ! zdaice "=" a_i
  540. ELSE ! if idonor
  541. ! Nothing happens since this category is not giving ice
  542. END IF ! if idonor
  543. END DO ! jj
  544. END DO ! ji
  545. END DO ! jl, category
  546. !-------------------------------------------------
  547. ! 2) Transfer volume and energy between categories
  548. !-------------------------------------------------
  549. DO jl = 1, jpl - 1
  550. DO ji = 1, jpi
  551. DO jj = 1, jpj
  552. IF (zdaice(ji,jj,jl) .GT. rzero ) THEN
  553. jl1 = idonor(ji,jj,jl)
  554. ! Define proportionality factor.
  555. ! zworka will be the ratio between transferred volume of ice and
  556. ! actual volume of ice in the category. Auxiliary quantities (snow volume, snow
  557. ! heat content, ice age, salinity, etc.) will be transferred following
  558. ! this ratio. Indeed, if out of 4 m of ice, 1 m is transferred, then
  559. ! 1/4 of the snow volume will be transferred, too.
  560. zindb = MAX( rzero , SIGN( rone , v_i(ji,jj,jl1) - epsi10 ) )
  561. ! Thus zindb is equal to 1 if the donor has positive and not artificially
  562. ! close to zero ice volume to give, to zero otherwise
  563. zworka(ji,jj) = zdvice(ji,jj,jl) / MAX( v_i(ji,jj,jl1), epsi10 ) *&
  564. &zindb
  565. ! zworka is zero where the donor has no ice, otherwise
  566. ! equal to zdvice/vice of the current category
  567. ! We have a donor, but who is the benefiter? who will receive ice?
  568. IF ( jl1 == jl ) THEN ! If the donor is the current category, then
  569. jl2=jl1+1 ! the receiver is the one above
  570. ELSE ! Otherwise (the donor is the above categ)
  571. jl2=jl ! then it's the current category!
  572. END IF
  573. ! -----------------------
  574. ! Go for the transfers!!!
  575. ! -----------------------
  576. ! A. Ice areas
  577. ! ------------
  578. a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - zdaice(ji,jj,jl)
  579. a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + zdaice(ji,jj,jl)
  580. ! The donor loses , the receiver gains
  581. ! B. Ice volumes
  582. ! --------------
  583. v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - zdvice(ji,jj,jl)
  584. v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + zdvice(ji,jj,jl)
  585. ! C. Snow volumes
  586. ! ---------------
  587. zdvsnow = v_s(ji,jj,jl1) * zworka(ji,jj)
  588. v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - zdvsnow
  589. v_s(ji,jj,jl2) = v_s(ji,jj,jl2) + zdvsnow
  590. ! D. Snow heat content
  591. ! --------------------
  592. IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  593. WRITE(*,*) 'Before itd_reb e_s_l01:' , e_s(ji,jj,1,jl)
  594. END IF
  595. DO jk = 1 , nlay_s
  596. zdesnow = e_s(ji,jj,jk,jl1) * zworka(ji,jj)
  597. e_s(ji,jj,jk,jl1) = e_s(ji,jj,jk,jl1) - zdesnow
  598. e_s(ji,jj,jk,jl2) = e_s(ji,jj,jk,jl2) + zdesnow
  599. IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  600. WRITE(*,*) 'Res shrink jl1:' , e_s(ji,jj,jk,jl1)
  601. WRITE(*,*) 'Res shrink jl2:' , e_s(ji,jj,jk,jl2)
  602. END IF
  603. END DO
  604. IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  605. WRITE(*,*) 'after itd_reb e_s_l01:' , e_s(ji,jj,1,jl)
  606. END IF
  607. ! E. Ice age
  608. ! ----------
  609. ! Ice age is defined as areal. If 1/2 of the area
  610. ! is transferred then 1/2 of the age too
  611. ! Wat een cromme definitie!
  612. zdo_aice = oa_i(ji,jj,jl1) * zdaice(ji,jj,jl)
  613. oa_i(ji,jj,jl1) = oa_i(ji,jj,jl1) - zdo_aice
  614. oa_i(ji,jj,jl2) = oa_i(ji,jj,jl2) + zdo_aice
  615. ! F. Ice salinity
  616. ! ---------------
  617. zdsm_vice = smv_i(ji,jj,jl1) * zworka(ji,jj)
  618. smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - zdsm_vice
  619. smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + zdsm_vice
  620. ! G. Surface temperature
  621. ! ----------------------
  622. zdaTsf = t_su(ji,jj,jl1) * zdaice(ji,jj,jl)
  623. zaTsfn(ji,jj,jl1) = zaTsfn(ji,jj,jl1) - zdaTsf
  624. zaTsfn(ji,jj,jl2) = zaTsfn(ji,jj,jl2) + zdaTsf
  625. ! H. Ice heat content
  626. ! -------------------
  627. DO jk = 1 , nlay_i
  628. zdeice = e_i(ji,jj,jk,jl1) * zworka(ji,jj)
  629. e_i(ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - zdeice
  630. e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + zdeice
  631. END DO
  632. ELSE
  633. ! WRITE(*,*),"Nothing to transfer"
  634. END IF
  635. END DO ! jpj
  636. END DO ! jpi
  637. END DO ! jl, category
  638. ! ---------------------------------------
  639. ! 3) Update ice thickness and temperature
  640. ! ---------------------------------------
  641. DO jl = 1 , jpl
  642. DO ji = 1 , jpi
  643. DO jj = 1 , jpj
  644. IF ( a_i(ji,jj,jl) > epsi10 ) THEN
  645. ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
  646. t_su(ji,jj,jl) = zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)
  647. ELSE
  648. ht_i(ji,jj,jl) = rzero
  649. t_su(ji,jj,jl) = rtt ! If no ice then set "ice" temperature to
  650. ! freezing point
  651. END IF
  652. END DO ! jj
  653. END DO !ji
  654. END DO ! jl
  655. WRITE(*,*) 'Leaving SUBROUTINE shiftice'
  656. END SUBROUTINE shiftice
  657. SUBROUTINE conc_check()
  658. USE my_variables
  659. IMPLICIT NONE
  660. ! Dummy variables
  661. INTEGER :: ji, jj, jl
  662. DO ji=1,jpi
  663. DO jj = 1,jpj
  664. DO jl=1,jpl
  665. ! 1. Individual concentrations greater than zero
  666. IF ( a_i(ji,jj,jl) .LT. rzero ) THEN
  667. IF (a_i(ji,jj,jl) .LT. -epsi10) THEN ! We have a "true" negative conc
  668. WRITE(*,*) 'ERROR: final check: a_i negative at ',ji,jj
  669. WRITE(*,*) 'for category ',jl
  670. WRITE(*,*) 'Value: ', a_i(ji,jj,jl)
  671. WRITE(*,*) 'ABORT'
  672. STOP
  673. ELSE ! We have a fake negative conc
  674. a_i(ji,jj,jl) = rzero
  675. ENDIF
  676. ENDIF
  677. ! 2. Individual concentrations less than one
  678. IF ( a_i(ji,jj,jl) .GT. zamax ) THEN
  679. IF (a_i(ji,jj,jl) - zamax .GT. epsi10) THEN ! We have a "true" positive conc
  680. WRITE(*,*) 'ERROR: final check: a_i more than zamax at ',ji,jj
  681. WRITE(*,*) 'for category ',jl
  682. WRITE(*,*) 'Value: ', a_i(ji,jj,jl)
  683. WRITE(*,*) 'ABORT'
  684. STOP
  685. ELSE ! We have a fake more than one conc
  686. a_i(ji,jj,jl) = zamax
  687. ENDIF
  688. ENDIF
  689. END DO ! jl
  690. ! 3. Total concentration greater than zero
  691. IF ( SUM(a_i(ji,jj,:)) .LT. rzero ) THEN
  692. IF (SUM(a_i(ji,jj,:)) .LT. -epsi10) THEN ! We have a "true" negative total conc
  693. WRITE(*,*) 'ERROR: final check: at_i negative at ',ji,jj
  694. WRITE(*,*) 'Value: ', SUM(a_i(ji,jj,:))
  695. WRITE(*,*) 'ABORT'
  696. STOP
  697. ELSE ! We have a fake negative conc
  698. ! Let's reset all categories to zero
  699. DO jl = 1, jpl
  700. a_i(ji,jj,jl)=rzero
  701. END DO
  702. ENDIF
  703. ENDIF
  704. ! 4. Total concentration less than one
  705. IF ( SUM(a_i(ji,jj,:)) .GT. zamax ) THEN
  706. IF (SUM(a_i(ji,jj,:)) - zamax .GT. epsi10) THEN ! We have a "true"positive conc
  707. WRITE(*,*) 'ERROR: final check: at_i more than one at ',ji,jj
  708. WRITE(*,*) 'Value: ', SUM(a_i(ji,jj,:))
  709. WRITE(*,*) 'Individual: ', a_i(ji,jj,:)
  710. WRITE(*,*) 'ABORT'
  711. STOP
  712. ELSE ! We have a fake more than one conc
  713. ! Define the excess, which is by definition negligible
  714. zda_i = SUM(a_i(ji,jj,:)) - zamax ! (positive)
  715. ! Give this excess to the first category than can accept it, i.e. that
  716. ! has less than zamax - zda_i
  717. l_adjust = .TRUE.
  718. DO jl = 1, jpl
  719. IF ( ( a_i(ji,jj,jl) .GT. zda_i ) .AND. l_adjust ) THEN
  720. a_i(ji,jj,jl) = a_i(ji,jj,jl) - zda_i
  721. l_adjust = .FALSE.
  722. END IF
  723. ENDDO ! jl
  724. IF ( l_adjust ) THEN
  725. WRITE(*,*) 'It was not possible to give the excess of ice.'
  726. WRITE(*,*) 'At grid point ',ji,jj
  727. WRITE(*,*) 'Category', jl
  728. WRITE(*,*) 'The excess is ', zda_i
  729. WRITE(*,*) 'The conc. in categories are ', a_i(ji,jj,:)
  730. WRITE(*,*) ' ABORT'
  731. STOP
  732. END IF
  733. ENDIF
  734. ENDIF
  735. END DO !jj
  736. END DO !ji
  737. END SUBROUTINE conc_check
  738. SUBROUTINE get_dimensions()
  739. USE my_variables
  740. USE netcdf
  741. IMPLICIT NONE
  742. ! Dummy variables
  743. WRITE(*,*), 'Entering get_dimensions()'
  744. ! 2.A Get dimensions
  745. ! ------------------
  746. ! Open the oce restart file
  747. ierr = nf90_open(TRIM(cfile_analysis_oce),nf90_Write,incid_oce_an_in)
  748. IF (ierr .NE. nf90_noerr ) THEN
  749. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Opening. Abort"
  750. WRITE(*,*), "File :" // TRIM(cfile_analysis_oce)
  751. STOP
  752. END IF
  753. ! Inquire variable id (here the variable does not matter!)
  754. ierr = nf90_inq_varid(incid_oce_an_in, "sn", ivarid)
  755. IF (ierr .NE. nf90_noerr ) THEN
  756. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Variable ID Inquiring. Abort"
  757. WRITE(*,*), "File :"//TRIM(cfile_analysis_oce)
  758. WRITE(*,*), "Variable: sn"
  759. STOP
  760. END IF
  761. ! Inquire variable
  762. ierr = nf90_inquire_variable(incid_oce_an_in, ivarid, dimids=idimid)
  763. IF (ierr .NE. nf90_noerr ) THEN
  764. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Variable Inquiring. Abort"
  765. WRITE(*,*), "File :"//TRIM(cfile_analysis_oce)
  766. WRITE(*,*), "Variable: sn"
  767. STOP
  768. END IF
  769. ! Get dimensions
  770. ierr = nf90_inquire_dimension(incid_oce_an_in, idimid(1), len=jpi)
  771. ierr = nf90_inquire_dimension(incid_oce_an_in, idimid(2), len=jpj)
  772. ierr = nf90_inquire_dimension(incid_oce_an_in, idimid(3), len=jpk)
  773. IF (ierr .NE. nf90_noerr ) THEN
  774. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF dimensions Inquiring. Abort"
  775. WRITE(*,*), "File :"//TRIM(cfile_analysis_oce)
  776. STOP
  777. END IF
  778. WRITE(*,*), "The model horizontal dimensions are" , jpi, "by",jpj
  779. WRITE(*,*), "The model vertical dimension is" , jpk
  780. WRITE(*,*), 'Leaving get_dimensions()'
  781. END SUBROUTINE get_dimensions
  782. SUBROUTINE get_nb_cat()
  783. USE my_variables
  784. USE netcdf
  785. IMPLICIT NONE
  786. ! Dummy variables
  787. INTEGER :: jl
  788. WRITE(*,*) 'Entering get_nb_cat()'
  789. ! Open file
  790. ierr = nf90_open(trim(cfile_analysis_ice),nf90_NoWrite,incid_ice_an_in)
  791. IF (ierr .NE. nf90_noerr ) THEN
  792. WRITE(*,*), "(sanity_check_SI3) Error NetCDF Ice file. Abort"
  793. WRITE(*,*), TRIM(cfile_analysis_ice)
  794. STOP
  795. END IF
  796. ! Get number of ice categories
  797. ! (2024-NEMOv4.2.1-SI3) Categories are now a dimension of variable, changes in consequence (Alison Delhasse)
  798. !cvarroot="a_i_htc"
  799. !jl=1
  800. !WRITE(cinteger,"(i1)") jl
  801. !ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//TRIM(cinteger), ivarid)
  802. !jl=jl+1
  803. !
  804. !DO WHILE (ierr == nf90_noerr)
  805. ! WRITE(cinteger,"(i1)") jl
  806. ! !WRITE(*,*),"Checking existence of " // TRIM(cconcroot)//TRIM(cinteger)
  807. ! ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//TRIM(cinteger), ivarid)
  808. ! jl=jl+1
  809. !ENDDO
  810. !
  811. !jpl=jl-2
  812. !WRITE(*,*), "There are ", jpl, "ice categories"
  813. ! Inquire variable id (here the variable does not matter!)
  814. ierr = nf90_inq_varid(incid_ice_an_in, "a_i", ivarid)
  815. IF (ierr .NE. nf90_noerr ) THEN
  816. WRITE(*,*), "(sanity_check_SI3) Error NetCDF Variable ID Inquiring. Abort"
  817. WRITE(*,*), "File :"//TRIM(cfile_analysis_ice)
  818. WRITE(*,*), "Variable: a_i"
  819. STOP
  820. END IF
  821. ! Inquire variable
  822. ierr = nf90_inquire_variable(incid_ice_an_in, ivarid, dimids=idimid)
  823. IF (ierr .NE. nf90_noerr ) THEN
  824. WRITE(*,*), "(sanity_check_SI3) Error NetCDF Variable Inquiring. Abort"
  825. WRITE(*,*), "File :"//TRIM(cfile_analysis_ice)
  826. WRITE(*,*), "Variable: a_i"
  827. STOP
  828. END IF
  829. ! Get dimensions
  830. ierr = nf90_inquire_dimension(incid_ice_an_in, idimid(3), len=jpl)
  831. !ierr = nf90_inquire_dimension(incid_oce_an_in, idimid(2), len=jpj)
  832. !ierr = nf90_inquire_dimension(incid_oce_an_in, idimid(3), len=jpk)
  833. IF (ierr .NE. nf90_noerr ) THEN
  834. WRITE(*,*), "(sanity_check_SI3) Error NetCDF dimensions Inquiring. Abort"
  835. WRITE(*,*), "File :"//TRIM(cfile_analysis_ice)
  836. STOP
  837. END IF
  838. WRITE(*,*), "There are ", jpl, "ice categories"
  839. ! Close
  840. ierr = nf90_close(incid_ice_an_in);
  841. IF (ierr .NE. nf90_noerr ) THEN
  842. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice close file. Abort"
  843. WRITE(*,*), TRIM(cfile_analysis_ice)
  844. STOP
  845. END IF
  846. WRITE(*,*) 'Leaving get_nb_cat()'
  847. END SUBROUTINE get_nb_cat
  848. SUBROUTINE get_nb_il()
  849. USE my_variables
  850. USE netcdf
  851. IMPLICIT NONE
  852. ! Dummy variables
  853. INTEGER :: jk
  854. WRITE(*,*) 'Entering get_nb_il()'
  855. ! Open file
  856. ierr = nf90_open(trim(cfile_analysis_ice),nf90_NoWrite,incid_ice_an_in)
  857. IF (ierr .NE. nf90_noerr ) THEN
  858. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file. Abort"
  859. WRITE(*,*), TRIM(cfile_analysis_ice)
  860. STOP
  861. END IF
  862. ! Changes in variables names in SI3 (2024) - changes in the subroutines Alison Delhasse
  863. ! cvarroot="tempt_il"
  864. cvarroot="e_i"
  865. jk=1
  866. WRITE(cinteger,"(i1)") jk
  867. ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//'_l0'//TRIM(cinteger), ivarid)
  868. jk=jk+1
  869. DO WHILE (ierr == nf90_noerr)
  870. WRITE(cinteger,"(i1)") jk
  871. ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//'_l0'//TRIM(cinteger), ivarid)
  872. jk=jk+1
  873. ENDDO
  874. nlay_i = jk-2
  875. WRITE(*,*), "There are ", nlay_i, "ice layers"
  876. ! Close
  877. ierr = nf90_close(incid_ice_an_in);
  878. IF (ierr .NE. nf90_noerr ) THEN
  879. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice close file. Abort"
  880. WRITE(*,*), TRIM(cfile_analysis_ice)
  881. STOP
  882. END IF
  883. WRITE(*,*) 'Leaving get_nb_il()'
  884. END SUBROUTINE get_nb_il
  885. SUBROUTINE get_nb_sl()
  886. USE my_variables
  887. USE netcdf
  888. IMPLICIT NONE
  889. ! Dummy variables
  890. INTEGER :: jk
  891. WRITE(*,*) 'Entering get_nb_sl()'
  892. ! Open file
  893. ierr = nf90_open(trim(cfile_analysis_ice),nf90_NoWrite,incid_ice_an_in)
  894. IF (ierr .NE. nf90_noerr ) THEN
  895. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file. Abort"
  896. WRITE(*,*), TRIM(cfile_analysis_ice)
  897. STOP
  898. END IF
  899. ! Changes in variables names in SI3 (2024) - changes in the subroutines Alison Delhasse
  900. cvarroot="e_s"
  901. jk=1
  902. WRITE(cinteger,"(i1)") jk
  903. ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//'_l0'//TRIM(cinteger), ivarid)
  904. jk=jk+1
  905. DO WHILE (ierr == nf90_noerr)
  906. WRITE(cinteger,"(i1)") jk
  907. ierr = nf90_inq_varid(incid_ice_an_in, TRIM(cvarroot)//'_l0'//TRIM(cinteger),ivarid)
  908. jk=jk+1
  909. ENDDO
  910. nlay_s = jk-2
  911. WRITE(*,*), "There are ", nlay_s, "snow layers"
  912. ! Close
  913. ierr = nf90_close(incid_ice_an_in);
  914. IF (ierr .NE. nf90_noerr ) THEN
  915. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice close file. Abort"
  916. WRITE(*,*), TRIM(cfile_analysis_ice)
  917. STOP
  918. END IF
  919. WRITE(*,*) 'Leaving get_nb_sl()'
  920. END SUBROUTINE get_nb_sl
  921. SUBROUTINE allocate_variables()
  922. USE my_variables
  923. IMPLICIT NONE
  924. WRITE(*,*), 'Entering allocate_variables()'
  925. ALLOCATE( ilandmask(jpi, jpj) )
  926. ALLOCATE( a_i( jpi, jpj, jpl) ,&
  927. &v_i( jpi, jpj, jpl) ,&
  928. &v_i_fc( jpi, jpj, jpl) ,&
  929. &v_s( jpi, jpj, jpl) ,&
  930. &v_s_fc( jpi, jpj, jpl) ,&
  931. &oa_i ( jpi, jpj, jpl) ,&
  932. &smv_i( jpi, jpj, jpl) ,&
  933. &t_su( jpi, jpj, jpl) )
  934. ALLOCATE( ht_i( jpi, jpj, jpl) )
  935. ALLOCATE( e_i( jpi, jpj,nlay_i,jpl) )
  936. ALLOCATE( e_s( jpi, jpj,nlay_s,jpl) )
  937. ALLOCATE( sss_m_an( jpi, jpj ) ,&
  938. sss_m_fc( jpi, jpj ) ,&
  939. sst_m_an( jpi, jpj ) ,&
  940. sst_m_fc( jpi, jpj ) )
  941. ALLOCATE( sn_an ( jpi, jpj,jpk ) ,&
  942. sn_fc ( jpi, jpj,jpk ) ,&
  943. tn_an ( jpi, jpj,jpk ) ,&
  944. tn_fc ( jpi, jpj,jpk ) ,&
  945. un_an ( jpi, jpj,jpk ) ,&
  946. un_fc ( jpi, jpj,jpk ) ,&
  947. ub_an ( jpi, jpj,jpk ) ,&
  948. ub_fc ( jpi, jpj,jpk ) ,&
  949. vn_an ( jpi, jpj,jpk ) ,&
  950. vn_fc ( jpi, jpj,jpk ) ,&
  951. vb_an ( jpi, jpj,jpk ) ,&
  952. vb_fc ( jpi, jpj,jpk ) )
  953. ALLOCATE( ssu_m_an( jpi, jpj ) ,&
  954. ssu_m_fc( jpi, jpj ) ,&
  955. ssv_m_an( jpi, jpj ) ,&
  956. ssv_m_fc( jpi, jpj ) )
  957. ALLOCATE( hi_max( jpl) )
  958. ALLOCATE( idonor( jpi, jpj, jpl) )
  959. ALLOCATE( internal_melt(jpi, jpj, jpl) )
  960. ALLOCATE( zdaice( jpi, jpj, jpl) ,&
  961. &zdvice( jpi, jpj, jpl) )
  962. ALLOCATE( ze1t( jpi, jpj ) ,&
  963. &ze2t( jpi, jpj ) ,&
  964. &zcellarea(jpi, jpj ) )
  965. ALLOCATE(zheat_res( jpi, jpj ) ,&
  966. &zdmsnif( jpi, jpj ) )
  967. ALLOCATE(at_i( jpi, jpj ) ,&
  968. snwice_mass(jpi,jpj ) ,&
  969. snwice_mass_b(jpi,jpj ) )
  970. WRITE(*,*) 'Leaving allocate_variables()'
  971. END SUBROUTINE allocate_variables
  972. SUBROUTINE load_variables()
  973. USE my_variables
  974. USE netcdf
  975. IMPLICIT NONE
  976. ! Dummy variables
  977. INTEGER :: jl, jk
  978. WRITE(*,*) 'Entering load_variables()'
  979. ! 3.A Mask
  980. ! --------
  981. ! Open
  982. ierr = nf90_open(TRIM(cmaskfile),nf90_NoWrite,incid_mask)
  983. IF (ierr .NE. nf90_noerr ) THEN
  984. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Mask file. Abort"
  985. WRITE(*,*), TRIM(cmaskfile)
  986. STOP
  987. END IF
  988. ! Request variable ID
  989. ierr = nf90_inq_varid(incid_mask, cmaskvar, ivarid)
  990. IF (ierr .NE. nf90_noerr ) THEN
  991. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Inquire varID . Abort"
  992. WRITE(*,*), TRIM(cmaskfile)
  993. STOP
  994. END IF
  995. ! Get the NetCDF variable and put it in the Fortran variable
  996. ierr = nf90_get_var(incid_mask, ivarid, ilandmask)
  997. IF (ierr .NE. nf90_noerr ) THEN
  998. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF getVar varID . Abort"
  999. WRITE(*,*), TRIM(cmaskfile)
  1000. STOP
  1001. END IF
  1002. ! Close mask file
  1003. ierr = nf90_close(incid_mask)
  1004. IF (ierr .NE. nf90_noerr ) THEN
  1005. WRITE(*,*), "(sanity_check_LIM3) Error Closing NetCDF . Abort"
  1006. WRITE(*,*), TRIM(cmaskfile)
  1007. STOP
  1008. END IF
  1009. ! 3.B Mesh file
  1010. ! -------------
  1011. ! Open
  1012. ierr = nf90_open(TRIM(cmeshfile),nf90_NoWrite,incid_mesh)
  1013. IF (ierr .NE. nf90_noerr ) THEN
  1014. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Mask file. Abort"
  1015. WRITE(*,*), TRIM(cmeshfile)
  1016. STOP
  1017. END IF
  1018. WRITE(*,*), "Mesh loaded"
  1019. ! Request variable ID
  1020. ierr = nf90_inq_varid(incid_mesh, ce1tvar, ivarid)
  1021. IF (ierr .NE. nf90_noerr ) THEN
  1022. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Inquire varID . Abort"
  1023. WRITE(*,*), TRIM(cmeshfile)
  1024. STOP
  1025. END IF
  1026. ! Get the NetCDF variable and put it in the Fortran variable
  1027. ierr = nf90_get_var(incid_mesh, ivarid, ze1t)
  1028. IF (ierr .NE. nf90_noerr ) THEN
  1029. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF getVar varID . Abort"
  1030. WRITE(*,*), TRIM(cmeshfile)
  1031. STOP
  1032. END IF
  1033. ! Repeat for e2t
  1034. ! Request variable ID
  1035. ierr = nf90_inq_varid(incid_mesh, ce2tvar, ivarid)
  1036. IF (ierr .NE. nf90_noerr ) THEN
  1037. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Inquire varID . Abort"
  1038. WRITE(*,*), TRIM(cmeshfile)
  1039. STOP
  1040. END IF
  1041. ! Get the NetCDF variable and put it in the Fortran variable
  1042. ierr = nf90_get_var(incid_mesh, ivarid, ze2t)
  1043. IF (ierr .NE. nf90_noerr ) THEN
  1044. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF getVar varID . Abort"
  1045. WRITE(*,*), TRIM(cmeshfile)
  1046. STOP
  1047. END IF
  1048. ! Close mesh file
  1049. ierr = nf90_close(incid_mesh)
  1050. IF (ierr .NE. nf90_noerr ) THEN
  1051. WRITE(*,*), "(sanity_check_LIM3) Error Closing NetCDF . Abort"
  1052. WRITE(*,*), TRIM(cmeshfile)
  1053. STOP
  1054. END IF
  1055. ! Computing zcellarea
  1056. zcellarea(:,:) = ze1t(:,:) * ze2t(:,:)
  1057. ! 3.C Ocean variables
  1058. ! -------------------
  1059. !
  1060. ! 3.C.1 Open analysis
  1061. ierr = nf90_open(trim(cfile_analysis_oce),nf90_NoWrite,incid_oce_an_in)
  1062. IF (ierr .NE. nf90_noerr ) THEN
  1063. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file. Abort"
  1064. WRITE(*,*), TRIM(cfile_analysis_oce)
  1065. STOP
  1066. END IF
  1067. ! The following lines commented out because SSS does not appear anymore
  1068. ! as restart variable (2020)
  1069. !! 3.C.1.A Sea surface salinity
  1070. !! Request variable ID
  1071. !ierr = nf90_inq_varid(incid_oce_an_in, csss_m, ivarid)
  1072. !IF (ierr .NE. nf90_noerr ) THEN
  1073. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1074. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1075. ! STOP
  1076. !END IF
  1077. !
  1078. !! Get variable
  1079. !ierr = nf90_get_var(incid_oce_an_in, ivarid, sss_m_an)
  1080. !IF (ierr .NE. nf90_noerr ) THEN
  1081. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1082. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1083. ! STOP
  1084. !END IF
  1085. !
  1086. ! 3.C.1.B Salinity
  1087. ! Request variable ID
  1088. ierr = nf90_inq_varid(incid_oce_an_in, csn, ivarid)
  1089. IF (ierr .NE. nf90_noerr ) THEN
  1090. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1091. WRITE(*,*), TRIM(cfile_analysis_oce)
  1092. STOP
  1093. END IF
  1094. ! Get variable
  1095. ierr = nf90_get_var(incid_oce_an_in, ivarid, sn_an)
  1096. IF (ierr .NE. nf90_noerr ) THEN
  1097. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1098. WRITE(*,*), TRIM(cfile_analysis_oce)
  1099. STOP
  1100. END IF
  1101. ! The following lines commented out because SST does not longer
  1102. ! appear as restart file (2020)
  1103. !! 3.C.1.C Sea surface temperature
  1104. !! Request variable ID
  1105. !ierr = nf90_inq_varid(incid_oce_an_in, csst_m, ivarid)
  1106. !IF (ierr .NE. nf90_noerr ) THEN
  1107. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1108. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1109. ! STOP
  1110. !END IF
  1111. !
  1112. !! Get variable
  1113. !ierr = nf90_get_var(incid_oce_an_in, ivarid, sst_m_an)
  1114. !IF (ierr .NE. nf90_noerr ) THEN
  1115. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1116. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1117. ! STOP
  1118. !END IF
  1119. ! 3.C.1.D. Temperature
  1120. ierr = nf90_inq_varid(incid_oce_an_in, ctn, ivarid)
  1121. IF (ierr .NE. nf90_noerr ) THEN
  1122. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1123. WRITE(*,*), TRIM(cfile_analysis_oce)
  1124. STOP
  1125. END IF
  1126. ! Get variable
  1127. ierr = nf90_get_var(incid_oce_an_in, ivarid, tn_an)
  1128. IF (ierr .NE. nf90_noerr ) THEN
  1129. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1130. WRITE(*,*), TRIM(cfile_analysis_oce)
  1131. STOP
  1132. END IF
  1133. ! 3.C.1.E U-velocity ("un")
  1134. ierr = nf90_inq_varid(incid_oce_an_in, cun, ivarid)
  1135. IF (ierr .NE. nf90_noerr ) THEN
  1136. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1137. WRITE(*,*), TRIM(cfile_analysis_oce)
  1138. STOP
  1139. END IF
  1140. ! Get variable
  1141. ierr = nf90_get_var(incid_oce_an_in, ivarid, un_an)
  1142. IF (ierr .NE. nf90_noerr ) THEN
  1143. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1144. WRITE(*,*), TRIM(cfile_analysis_oce)
  1145. STOP
  1146. END IF
  1147. ! 3.C.1.F U-velocity ("ub")
  1148. ierr = nf90_inq_varid(incid_oce_an_in, cub, ivarid)
  1149. IF (ierr .NE. nf90_noerr ) THEN
  1150. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1151. WRITE(*,*), TRIM(cfile_analysis_oce)
  1152. STOP
  1153. END IF
  1154. ! Get variable
  1155. ierr = nf90_get_var(incid_oce_an_in, ivarid, ub_an)
  1156. IF (ierr .NE. nf90_noerr ) THEN
  1157. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1158. WRITE(*,*), TRIM(cfile_analysis_oce)
  1159. STOP
  1160. END IF
  1161. ! 3.C.1.G V-velocity ("vn")
  1162. ierr = nf90_inq_varid(incid_oce_an_in, cvn, ivarid)
  1163. IF (ierr .NE. nf90_noerr ) THEN
  1164. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1165. WRITE(*,*), TRIM(cfile_analysis_oce)
  1166. STOP
  1167. END IF
  1168. ! Get variable
  1169. ierr = nf90_get_var(incid_oce_an_in, ivarid, vn_an)
  1170. IF (ierr .NE. nf90_noerr ) THEN
  1171. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1172. WRITE(*,*), TRIM(cfile_analysis_oce)
  1173. STOP
  1174. END IF
  1175. ! 3.C.1.H V-velocity ("vb")
  1176. ierr = nf90_inq_varid(incid_oce_an_in, cvb, ivarid)
  1177. IF (ierr .NE. nf90_noerr ) THEN
  1178. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1179. WRITE(*,*), TRIM(cfile_analysis_oce)
  1180. STOP
  1181. END IF
  1182. ! Get variable
  1183. ierr = nf90_get_var(incid_oce_an_in, ivarid, vb_an)
  1184. IF (ierr .NE. nf90_noerr ) THEN
  1185. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1186. WRITE(*,*), TRIM(cfile_analysis_oce)
  1187. STOP
  1188. END IF
  1189. ! The following lines commented out because surface velocities no longer
  1190. ! appear as restart variables (2020)
  1191. !! 3.C.1.I SSU-velocity ("ssu_m")
  1192. !ierr = nf90_inq_varid(incid_oce_an_in, cssu_m, ivarid)
  1193. !IF (ierr .NE. nf90_noerr ) THEN
  1194. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1195. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1196. ! STOP
  1197. !END IF
  1198. !
  1199. !! Get variable
  1200. !ierr = nf90_get_var(incid_oce_an_in, ivarid, ssu_m_an)
  1201. !IF (ierr .NE. nf90_noerr ) THEN
  1202. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1203. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1204. ! STOP
  1205. !END IF
  1206. !
  1207. !! 3.C.1.J SSV-velocity ("ssv_m")
  1208. !ierr = nf90_inq_varid(incid_oce_an_in, cssv_m, ivarid)
  1209. !IF (ierr .NE. nf90_noerr ) THEN
  1210. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1211. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1212. ! STOP
  1213. !END IF
  1214. !
  1215. !! Get variable
  1216. !ierr = nf90_get_var(incid_oce_an_in, ivarid, ssv_m_an)
  1217. !IF (ierr .NE. nf90_noerr ) THEN
  1218. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1219. ! WRITE(*,*), TRIM(cfile_analysis_oce)
  1220. ! STOP
  1221. !END IF
  1222. ! Close analysis
  1223. ierr = nf90_close(incid_oce_an_in);
  1224. IF (ierr .NE. nf90_noerr ) THEN
  1225. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean close file. Abort"
  1226. WRITE(*,*), TRIM(cfile_analysis_oce)
  1227. STOP
  1228. END IF
  1229. ! 3.C.2. Open forecast
  1230. ierr = nf90_open(trim(cfile_forecast_oce),nf90_NoWrite,incid_oce_fc_in)
  1231. IF (ierr .NE. nf90_noerr ) THEN
  1232. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file. Abort"
  1233. WRITE(*,*), TRIM(cfile_forecast_oce)
  1234. STOP
  1235. END IF
  1236. ! Following lines commented out as the variable no longer appears
  1237. ! in the restart files (2020
  1238. !! 3.C.2.A Sea surface salinity
  1239. !! Request variable ID
  1240. !ierr = nf90_inq_varid(incid_oce_fc_in, csss_m, ivarid)
  1241. !IF (ierr .NE. nf90_noerr ) THEN
  1242. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1243. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1244. ! STOP
  1245. !END IF
  1246. !
  1247. !! Get variable
  1248. !ierr = nf90_get_var(incid_oce_fc_in, ivarid, sss_m_fc)
  1249. !IF (ierr .NE. nf90_noerr ) THEN
  1250. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1251. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1252. ! STOP
  1253. !END IF
  1254. ! 3.C.2.B. Salinity
  1255. ! Request variable ID
  1256. ierr = nf90_inq_varid(incid_oce_fc_in, csn, ivarid)
  1257. IF (ierr .NE. nf90_noerr ) THEN
  1258. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1259. WRITE(*,*), TRIM(cfile_forecast_oce)
  1260. STOP
  1261. END IF
  1262. ! Get variable
  1263. ierr = nf90_get_var(incid_oce_fc_in, ivarid, sn_fc)
  1264. IF (ierr .NE. nf90_noerr ) THEN
  1265. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1266. WRITE(*,*), TRIM(cfile_forecast_oce)
  1267. STOP
  1268. END IF
  1269. ! Following lines commented out as the variable no longer appears
  1270. ! in the restart files (2020)
  1271. !! 3.C.2.C Sea surface temperature
  1272. !! Request variable ID
  1273. !ierr = nf90_inq_varid(incid_oce_fc_in, csst_m, ivarid)
  1274. !IF (ierr .NE. nf90_noerr ) THEN
  1275. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1276. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1277. ! STOP
  1278. !END IF
  1279. !
  1280. !! Get variable
  1281. !ierr = nf90_get_var(incid_oce_fc_in, ivarid, sst_m_fc)
  1282. !IF (ierr .NE. nf90_noerr ) THEN
  1283. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1284. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1285. ! STOP
  1286. !END IF
  1287. ! 3.C.2.D. Temperature
  1288. ! Request variable ID
  1289. ierr = nf90_inq_varid(incid_oce_fc_in, ctn, ivarid)
  1290. IF (ierr .NE. nf90_noerr ) THEN
  1291. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1292. WRITE(*,*), TRIM(cfile_forecast_oce)
  1293. STOP
  1294. END IF
  1295. ! Get variable
  1296. ierr = nf90_get_var(incid_oce_fc_in, ivarid, tn_fc)
  1297. IF (ierr .NE. nf90_noerr ) THEN
  1298. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1299. WRITE(*,*), TRIM(cfile_forecast_oce)
  1300. STOP
  1301. END IF
  1302. ! 3.C.2.E U-velocity ("un")
  1303. ierr = nf90_inq_varid(incid_oce_fc_in, cun, ivarid)
  1304. IF (ierr .NE. nf90_noerr ) THEN
  1305. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1306. WRITE(*,*), TRIM(cfile_forecast_oce)
  1307. STOP
  1308. END IF
  1309. ! Get variable
  1310. ierr = nf90_get_var(incid_oce_fc_in, ivarid, un_fc)
  1311. IF (ierr .NE. nf90_noerr ) THEN
  1312. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1313. WRITE(*,*), TRIM(cfile_forecast_oce)
  1314. STOP
  1315. END IF
  1316. ! 3.C.2.F U-velocity ("ub")
  1317. ierr = nf90_inq_varid(incid_oce_fc_in, cub, ivarid)
  1318. IF (ierr .NE. nf90_noerr ) THEN
  1319. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1320. WRITE(*,*), TRIM(cfile_forecast_oce)
  1321. STOP
  1322. END IF
  1323. ! Get variable
  1324. ierr = nf90_get_var(incid_oce_fc_in, ivarid, ub_fc)
  1325. IF (ierr .NE. nf90_noerr ) THEN
  1326. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1327. WRITE(*,*), TRIM(cfile_forecast_oce)
  1328. STOP
  1329. END IF
  1330. ! 3.C.2.G V-velocity ("vn")
  1331. ierr = nf90_inq_varid(incid_oce_fc_in, cvn, ivarid)
  1332. IF (ierr .NE. nf90_noerr ) THEN
  1333. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1334. WRITE(*,*), TRIM(cfile_forecast_oce)
  1335. STOP
  1336. END IF
  1337. ! Get variable
  1338. ierr = nf90_get_var(incid_oce_fc_in, ivarid, vn_fc)
  1339. IF (ierr .NE. nf90_noerr ) THEN
  1340. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1341. WRITE(*,*), TRIM(cfile_forecast_oce)
  1342. STOP
  1343. END IF
  1344. ! 3.C.2.H V-velocity ("vb")
  1345. ierr = nf90_inq_varid(incid_oce_fc_in, cvb, ivarid)
  1346. IF (ierr .NE. nf90_noerr ) THEN
  1347. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1348. WRITE(*,*), TRIM(cfile_forecast_oce)
  1349. STOP
  1350. END IF
  1351. ! Get variable
  1352. ierr = nf90_get_var(incid_oce_fc_in, ivarid, vb_fc)
  1353. IF (ierr .NE. nf90_noerr ) THEN
  1354. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1355. WRITE(*,*), TRIM(cfile_forecast_oce)
  1356. STOP
  1357. END IF
  1358. ! Following lines commented out as the variable no longer appears
  1359. ! in the restart files (2020)
  1360. !! 3.C.2.I SSU-velocity ("ssu_m")
  1361. !ierr = nf90_inq_varid(incid_oce_fc_in, cssu_m, ivarid)
  1362. !IF (ierr .NE. nf90_noerr ) THEN
  1363. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1364. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1365. ! STOP
  1366. !END IF
  1367. !
  1368. !! Get variable
  1369. !ierr = nf90_get_var(incid_oce_fc_in, ivarid, ssu_m_fc)
  1370. !IF (ierr .NE. nf90_noerr ) THEN
  1371. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1372. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1373. ! STOP
  1374. !END IF
  1375. !! 3.C.2.J SSV-velocity ("ssv_m")
  1376. !ierr = nf90_inq_varid(incid_oce_fc_in, cssv_m, ivarid)
  1377. !IF (ierr .NE. nf90_noerr ) THEN
  1378. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file var. inquiry. Abort"
  1379. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1380. ! STOP
  1381. !END IF
  1382. !
  1383. ! Get variable
  1384. !ierr = nf90_get_var(incid_oce_fc_in, ivarid, ssv_m_fc)
  1385. !IF (ierr .NE. nf90_noerr ) THEN
  1386. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file get. Abort"
  1387. ! WRITE(*,*), TRIM(cfile_forecast_oce)
  1388. ! STOP
  1389. !END IF
  1390. ! Close forecast
  1391. ierr = nf90_close(incid_oce_fc_in);
  1392. IF (ierr .NE. nf90_noerr ) THEN
  1393. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean close file. Abort"
  1394. WRITE(*,*), TRIM(cfile_forecast_oce)
  1395. STOP
  1396. END IF
  1397. WRITE(*,*), "Ocean variables loaded"
  1398. ! 3.D Ice variables
  1399. ! -----------------
  1400. !#################!
  1401. !# Open forecast #
  1402. !#################!
  1403. ierr = nf90_open(trim(cfile_forecast_ice),nf90_NoWrite,incid_ice_fc_in)
  1404. IF (ierr .NE. nf90_noerr ) THEN
  1405. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file. Abort"
  1406. WRITE(*,*), TRIM(cfile_forecast_ice)
  1407. STOP
  1408. END IF
  1409. ! (2024) ice category is now a dimension of the variables. No need to loop with the cat index to load variables.
  1410. !DO jl = 1 , jpl
  1411. ! Read ice volume forecast
  1412. cvarroot='v_i'
  1413. cvarname = TRIM(cvarroot)
  1414. ! Inquire variable ID
  1415. ierr = nf90_inq_varid(incid_ice_fc_in, cvarname, ivarid)
  1416. IF (ierr .NE. nf90_noerr ) THEN
  1417. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1418. WRITE(*,*), TRIM(cfile_forecast_ice)
  1419. WRITE(*,*), cvarname
  1420. STOP
  1421. END IF
  1422. ! Read variable
  1423. ierr = nf90_get_var(incid_ice_fc_in, ivarid, v_i_fc)
  1424. IF (ierr .NE. nf90_noerr ) THEN
  1425. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1426. WRITE(*,*), TRIM(cfile_forecast_ice)
  1427. WRITE(*,*), cvarname
  1428. STOP
  1429. END IF
  1430. ! Read snow volume forecast
  1431. cvarroot='v_s'
  1432. cvarname = TRIM(cvarroot)
  1433. ! Inquire variable ID
  1434. ierr = nf90_inq_varid(incid_ice_fc_in, cvarname, ivarid)
  1435. IF (ierr .NE. nf90_noerr ) THEN
  1436. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1437. WRITE(*,*), TRIM(cfile_forecast_ice)
  1438. WRITE(*,*), cvarname
  1439. STOP
  1440. END IF
  1441. ! Read variable
  1442. ierr = nf90_get_var(incid_ice_fc_in, ivarid, v_s_fc)
  1443. IF (ierr .NE. nf90_noerr ) THEN
  1444. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1445. WRITE(*,*), TRIM(cfile_forecast_ice)
  1446. WRITE(*,*), cvarname
  1447. STOP
  1448. END IF
  1449. !END DO ! jl
  1450. ! Close forecast
  1451. ierr = nf90_close(incid_ice_fc_in);
  1452. IF (ierr .NE. nf90_noerr ) THEN
  1453. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice close file. Abort"
  1454. WRITE(*,*), TRIM(cfile_forecast_ice)
  1455. STOP
  1456. END IF
  1457. WRITE(*,*), "Ice forecast variables loaded"
  1458. !!!!---------------------------------------------------------------------!!!
  1459. !#################!
  1460. !# Open analysis #!
  1461. !#################!
  1462. ierr = nf90_open(trim(cfile_analysis_ice),nf90_NoWrite,incid_ice_an_in)
  1463. IF (ierr .NE. nf90_noerr ) THEN
  1464. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file. Abort"
  1465. WRITE(*,*), TRIM(cfile_analysis_ice)
  1466. STOP
  1467. END IF
  1468. ! Time counter
  1469. ! Request variable id
  1470. cvarname = 'time_counter'
  1471. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1472. IF (ierr .NE. nf90_noerr ) THEN
  1473. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1474. WRITE(*,*), TRIM(cfile_analysis_ice)
  1475. WRITE(*,*), cvarname
  1476. STOP
  1477. END IF
  1478. ! Get variable
  1479. ierr = nf90_get_var(incid_ice_an_in, ivarid, ztime_counter )
  1480. IF (ierr .NE. nf90_noerr ) THEN
  1481. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1482. WRITE(*,*), TRIM(cfile_analysis_ice)
  1483. WRITE(*,*), cvarname
  1484. STOP
  1485. END IF
  1486. ! Strategy: Loop over categories, and for specific variables over layers
  1487. ! (2024) Categories as dim now!
  1488. !DO jl = 1 , jpl
  1489. ! 3.D.1. Ice concentration
  1490. cvarroot='a_i'
  1491. cvarname = TRIM(cvarroot)
  1492. ! WRITE(*,*), "Working with variable " // cvarname
  1493. ! Request variable ID
  1494. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1495. IF (ierr .NE. nf90_noerr ) THEN
  1496. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1497. WRITE(*,*), TRIM(cfile_analysis_ice)
  1498. WRITE(*,*), cvarname
  1499. STOP
  1500. END IF
  1501. ! Get variable
  1502. ierr = nf90_get_var(incid_ice_an_in, ivarid, a_i)
  1503. IF (ierr .NE. nf90_noerr ) THEN
  1504. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1505. WRITE(*,*), TRIM(cfile_analysis_ice)
  1506. WRITE(*,*), cvarname
  1507. STOP
  1508. END IF
  1509. ! 3.D.2. Ice volume per surface area
  1510. cvarroot='v_i'
  1511. cvarname = TRIM(cvarroot)
  1512. ! WRITE(*,*), "Working with variable " // cvarname
  1513. ! Request variable ID
  1514. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1515. IF (ierr .NE. nf90_noerr ) THEN
  1516. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1517. WRITE(*,*), TRIM(cfile_analysis_ice)
  1518. WRITE(*,*), cvarname
  1519. STOP
  1520. END IF
  1521. ! Get variable
  1522. ierr = nf90_get_var(incid_ice_an_in, ivarid, v_i)
  1523. IF (ierr .NE. nf90_noerr ) THEN
  1524. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1525. WRITE(*,*), TRIM(cfile_analysis_ice)
  1526. WRITE(*,*), cvarname
  1527. STOP
  1528. END IF
  1529. ! 3.D.3. Snow volume per surface area
  1530. cvarroot='v_s'
  1531. cvarname = TRIM(cvarroot)
  1532. WRITE(*,*), "Working with variable " // cvarname
  1533. ! Request variable ID
  1534. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1535. IF (ierr .NE. nf90_noerr ) THEN
  1536. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1537. WRITE(*,*), TRIM(cfile_analysis_ice)
  1538. WRITE(*,*), cvarname
  1539. STOP
  1540. END IF
  1541. ! Get variable
  1542. ierr = nf90_get_var(incid_ice_an_in, ivarid, v_s)
  1543. IF (ierr .NE. nf90_noerr ) THEN
  1544. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1545. WRITE(*,*), TRIM(cfile_analysis_ice)
  1546. WRITE(*,*), cvarname
  1547. STOP
  1548. END IF
  1549. ! 3.D.4. Ice age
  1550. cvarroot='oa_i'
  1551. cvarname = TRIM(cvarroot)
  1552. ! WRITE(*,*), "Working with variable " // cvarname
  1553. ! Request variable ID
  1554. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1555. IF (ierr .NE. nf90_noerr ) THEN
  1556. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1557. WRITE(*,*), TRIM(cfile_analysis_ice)
  1558. WRITE(*,*), cvarname
  1559. STOP
  1560. END IF
  1561. ! Get variable
  1562. ierr = nf90_get_var(incid_ice_an_in, ivarid, oa_i)
  1563. IF (ierr .NE. nf90_noerr ) THEN
  1564. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1565. WRITE(*,*), TRIM(cfile_analysis_ice)
  1566. WRITE(*,*), cvarname
  1567. STOP
  1568. END IF
  1569. ! 3.D.5. Ice salinity
  1570. cvarroot='sv_i'
  1571. cvarname = TRIM(cvarroot)
  1572. ! WRITE(*,*), "Working with variable " // cvarname
  1573. ! Request variable ID
  1574. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1575. IF (ierr .NE. nf90_noerr ) THEN
  1576. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1577. WRITE(*,*), TRIM(cfile_analysis_ice)
  1578. WRITE(*,*), cvarname
  1579. STOP
  1580. END IF
  1581. ! Get variable
  1582. ierr = nf90_get_var(incid_ice_an_in, ivarid, smv_i)
  1583. IF (ierr .NE. nf90_noerr ) THEN
  1584. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1585. WRITE(*,*), TRIM(cfile_analysis_ice)
  1586. WRITE(*,*), cvarname
  1587. STOP
  1588. END IF
  1589. ! 3.D.5. Ice surface temperature
  1590. !cvarroot='t_su_htc'
  1591. !WRITE(cinteger,'(i1)') jl
  1592. !cvarname = TRIM(cvarroot) // TRIM(cinteger)
  1593. ! ! WRITE(*,*), "Working with variable " // cvarname
  1594. !! Request variable ID
  1595. !ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1596. !IF (ierr .NE. nf90_noerr ) THEN
  1597. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1598. ! WRITE(*,*), TRIM(cfile_analysis_ice)
  1599. ! WRITE(*,*), cvarname
  1600. ! STOP
  1601. !END IF
  1602. !! Get variable
  1603. !ierr = nf90_get_var(incid_ice_an_in, ivarid, t_su(:,:,jl) )
  1604. !IF (ierr .NE. nf90_noerr ) THEN
  1605. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1606. ! WRITE(*,*), TRIM(cfile_analysis_ice)
  1607. ! WRITE(*,*), cvarname
  1608. ! STOP
  1609. !END IF
  1610. cvarroot='t_su'
  1611. cvarname = TRIM(cvarroot)
  1612. WRITE(*,*), "Working with variable " // cvarname
  1613. ! Request variable ID
  1614. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1615. IF (ierr .NE. nf90_noerr ) THEN
  1616. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1617. WRITE(*,*), TRIM(cfile_analysis_ice)
  1618. WRITE(*,*), cvarname
  1619. STOP
  1620. END IF
  1621. ! Get variable
  1622. ierr = nf90_get_var(incid_ice_an_in, ivarid, t_su)
  1623. IF (ierr .NE. nf90_noerr ) THEN
  1624. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1625. WRITE(*,*), TRIM(cfile_analysis_ice)
  1626. WRITE(*,*), cvarname
  1627. STOP
  1628. END IF
  1629. ! 3.D.X Variables that are defined on several ice layers
  1630. DO jk = 1 , nlay_i
  1631. ! Ice enthalpy in layers
  1632. cvarroot='e_i_l0'
  1633. WRITE(cinteger2,'(i1)') jk
  1634. cvarname = TRIM(cvarroot)//TRIM(cinteger2)
  1635. ! WRITE(*,*),"Working with variable " // cvarname
  1636. ! Request variable ID
  1637. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1638. IF (ierr .NE. nf90_noerr ) THEN
  1639. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1640. WRITE(*,*), TRIM(cfile_analysis_ice)
  1641. WRITE(*,*), cvarname
  1642. STOP
  1643. END IF
  1644. ! Get variable
  1645. ierr = nf90_get_var(incid_ice_an_in, ivarid, e_i(:,:,jk,:) )
  1646. IF (ierr .NE. nf90_noerr ) THEN
  1647. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1648. WRITE(*,*), TRIM(cfile_analysis_ice)
  1649. WRITE(*,*), cvarname
  1650. STOP
  1651. END IF
  1652. ENDDO ! jk, layers
  1653. DO jk = 1 , nlay_s
  1654. ! Snow enthalpy in layers
  1655. cvarroot='e_s_l0'
  1656. WRITE(cinteger2,'(i1)') jk
  1657. cvarname = TRIM(cvarroot)// TRIM(cinteger2)
  1658. ! WRITE(*,*),"Working with variable " // cvarname
  1659. ! Request variable ID
  1660. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1661. IF (ierr .NE. nf90_noerr ) THEN
  1662. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1663. WRITE(*,*), TRIM(cfile_analysis_ice)
  1664. WRITE(*,*), cvarname
  1665. STOP
  1666. END IF
  1667. ! Get variable
  1668. ierr = nf90_get_var(incid_ice_an_in, ivarid, e_s(:,:,jk,:) )
  1669. IF (ierr .NE. nf90_noerr ) THEN
  1670. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1671. WRITE(*,*), TRIM(cfile_analysis_ice)
  1672. WRITE(*,*), cvarname
  1673. STOP
  1674. END IF
  1675. ENDDO ! jk, layers
  1676. !ENDDO ! jl, categories
  1677. ! Load data that don't depend on categories
  1678. WRITE(*,*), "Ice analyse 3-D variables loaded (category and layers)"
  1679. ! Snow ice mass
  1680. cvarname = 'snwice_mass'
  1681. ! Request variable ID
  1682. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1683. IF (ierr .NE. nf90_noerr ) THEN
  1684. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1685. WRITE(*,*), TRIM(cfile_analysis_ice)
  1686. WRITE(*,*), cvarname
  1687. STOP
  1688. END IF
  1689. ! Get variable
  1690. ierr = nf90_get_var(incid_ice_an_in, ivarid, snwice_mass(:,:) )
  1691. IF (ierr .NE. nf90_noerr ) THEN
  1692. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1693. WRITE(*,*), TRIM(cfile_analysis_ice)
  1694. WRITE(*,*), cvarname
  1695. STOP
  1696. END IF
  1697. ! Snow ice mass_b
  1698. cvarname = 'snwice_mass_b'
  1699. ! Request variable ID
  1700. ierr = nf90_inq_varid(incid_ice_an_in, cvarname, ivarid)
  1701. IF (ierr .NE. nf90_noerr ) THEN
  1702. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file var. inquiry. Abort"
  1703. WRITE(*,*), TRIM(cfile_analysis_ice)
  1704. WRITE(*,*), cvarname
  1705. STOP
  1706. END IF
  1707. ! Get variable
  1708. ierr = nf90_get_var(incid_ice_an_in, ivarid, snwice_mass_b(:,:) )
  1709. IF (ierr .NE. nf90_noerr ) THEN
  1710. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice file get. Abort"
  1711. WRITE(*,*), TRIM(cfile_analysis_ice)
  1712. WRITE(*,*), cvarname
  1713. STOP
  1714. END IF
  1715. ! Close ice analysis file
  1716. ierr = nf90_close(incid_ice_an_in);
  1717. IF (ierr .NE. nf90_noerr ) THEN
  1718. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ice close file. Abort"
  1719. WRITE(*,*), TRIM(cfile_analysis_ice)
  1720. STOP
  1721. END IF
  1722. WRITE(*,*), "Ice forecast without category dim variables loaded"
  1723. WRITE(*,*) 'Leaving load_variables'
  1724. END SUBROUTINE load_variables
  1725. SUBROUTINE several_ice_corrections()
  1726. USE my_variables
  1727. IMPLICIT NONE
  1728. ! Dummy variables
  1729. INTEGER :: ji, jj, jl, jk
  1730. WRITE(*,*), 'Entering several_ice_corrections()'
  1731. DO ji = 1 , jpi
  1732. DO jj = 1 , jpj
  1733. DO jl = 1 , jpl
  1734. ! Define switches (masks)
  1735. !zindb = MAX( rzero , SIGN( zamax , a_i(ji,jj,jl) - epsi06) )
  1736. !zindsn = MAX(rzero , SIGN( zamax , v_s(ji,jj,jl) - epsi06) )
  1737. !zindic = MAX(rzero , SIGN( zamax , v_i(ji,jj,jl) - epsi04) )
  1738. zindb = MAX( rzero , SIGN( rone , a_i(ji,jj,jl) - epsi06) )
  1739. zindsn = MAX(rzero , SIGN( rone , v_s(ji,jj,jl) - epsi06) )
  1740. zindic = MAX(rzero , SIGN( rone , v_i(ji,jj,jl) - epsi04) )
  1741. zindb = zindb * zindic ! Mask where there is conc. AND volume
  1742. ! A. Corrections to ice age
  1743. ![AD] test without modifing age, so analysis = forecast
  1744. !IF ( ( oa_i(ji,jj,jl) - rone ) * 86400.0 .GT. ( rdt_ice*ztime_counter*a_i(ji,jj,jl) ) )&
  1745. !&THEN
  1746. !WRITE(*,*) 'Correction on ice age'
  1747. ! oa_i(ji,jj,jl) = rdt_ice * ztime_counter / 86400.0 * a_i(ji,jj,jl)
  1748. !END IF
  1749. !oa_i(ji,jj,jl) = zindb*oa_i(ji,jj,jl)
  1750. ! B. Corrections to snow thickness
  1751. v_s(ji,jj,jl) = zindsn*zindb*v_s(ji,jj,jl)
  1752. ! C. Corrections to ice thickness
  1753. v_i(ji,jj,jl) = MAX( zindb * v_i(ji,jj,jl) , rzero )
  1754. v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl)
  1755. ! D. Snow transformed to ice if original ice cover disappears
  1756. zindg = REAL(ilandmask(ji,jj) ) * MAX (rzero, SIGN( rone , - v_i (ji,jj,jl) ) )
  1757. ! (is it possible to have zindg not zero??)
  1758. v_i(ji,jj,jl) = v_i(ji,jj,jl) + zindg * zrhosn * v_s(ji,jj,jl) / zrho0
  1759. ! The last term of the above equation is the water volume equivalent to the snow
  1760. ! volume I guess
  1761. v_s(ji,jj,jl) = (rone - zindg ) * v_s(ji,jj,jl) + &
  1762. & zindg * v_i(ji,jj,jl) * (zrho0 - zrhoic ) / zrhosn
  1763. ! E. Correction to ice concentration
  1764. a_i(ji,jj,jl) = zindb * MAX(zindsn, zindic) * MAX(a_i(ji,jj,jl), epsi06)
  1765. ! F. Correction to snow heat contenti
  1766. ![AD] Add loop on layer also for e_s to test!
  1767. IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  1768. WRITE(*,*) 'Before i=307 j=307 e_s_l01:' , e_s(ji,jj,1,jl)
  1769. END IF
  1770. DO jk = 1 , nlay_s
  1771. e_s(ji,jj,jk,jl) = zindsn * &
  1772. & ( MIN ( MAX ( rzero, e_s(ji,jj,jk,jl) ), zbigvalue ) ) + &
  1773. & ( rone - zindsn ) * rzero
  1774. END DO
  1775. IF ( ldebug .AND. ( ji == jiindx ) .AND. ( jj == jjindx ) ) THEN
  1776. WRITE(*,*) 'After i=307 j=307 e_s_l010:' , e_s(ji,jj,1,jl)
  1777. END IF
  1778. ! G. Correction to ice heat content
  1779. DO jk = 1 , nlay_i
  1780. e_i(ji,jj,jk,jl) = zindic * &
  1781. &( MIN( MAX( rzero, e_i(ji,jj,jk,jl) ), zbigvalue ) ) &
  1782. & + (rone - zindic ) * rzero
  1783. END DO ! nlay_i
  1784. ! H. Correction to ice salinity
  1785. IF ( (num_sal .EQ. 2) .OR. (num_sal .EQ. 4) ) THEN
  1786. ! If we are in salinity profile mode
  1787. ! Salinity stays in bounds
  1788. smv_i(ji,jj,jl) = MAX( MIN( (zrhoic-zrhosn)/zrhoic * &
  1789. & sss_m_an(ji,jj) , smv_i(ji,jj,jl) ) , &
  1790. 0.1 * v_i(ji,jj,jl) )
  1791. ENDIF
  1792. ! I. Thickness of first category above 5cm
  1793. IF ( jl == 1) THEN
  1794. ht_i(ji,jj,jl) = zindb * v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),epsi06)
  1795. zh = MAX(rone , zindb*zhiclim/ &
  1796. & MAX(ht_i(ji,jj,jl),epsi20 ) )
  1797. ! This is a correction factor equal to zhiclim/h_insitu, i.e. the ratio
  1798. ! between minimal and actual in situ thickness.
  1799. ! Something to do for the snow
  1800. ! The ice concentration is shrunk so that the ice thickness is at least
  1801. ! zhiclim
  1802. a_i(ji,jj,jl) = a_i(ji,jj,jl) / zh
  1803. END IF
  1804. END DO ! jl
  1805. ! Reset snowice to zero if necessary
  1806. IF ( (snwice_mass(ji,jj) .LT. rzero) .OR. (snwice_mass_b(ji,jj) .LT. rzero) ) THEN
  1807. snwice_mass(ji,jj) = rzero
  1808. snwice_mass_b(ji,jj)=rzero
  1809. END IF
  1810. END DO ! jj
  1811. END DO ! ji
  1812. WRITE(*,*), 'Leaving several_ice_corrections()'
  1813. END SUBROUTINE several_ice_corrections
  1814. SUBROUTINE shrink_ice()
  1815. USE my_variables
  1816. IMPLICIT NONE
  1817. ! Dummy variables
  1818. INTEGER :: ji, jj, jl
  1819. WRITE(*,*), 'Entering shrink_ice()'
  1820. ! Total concentration cannot exceed zamax
  1821. at_i(:,:) = rzero
  1822. DO jl = 1 , jpl
  1823. at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
  1824. END DO
  1825. DO ji = 1 , jpi
  1826. DO jj = 1 , jpj
  1827. ! Define the excessive concentration
  1828. zda_ex = MAX( at_i(ji,jj) - zamax , rzero )
  1829. ! (i.e. rzero, except if excess)
  1830. DO jl = 1 , jpl
  1831. zindb = MAX( rzero , SIGN( rone , v_i(ji,jj,jl) ) )
  1832. ! (zindb is a mask)
  1833. ! Spread the excess over the different categories with weight equal
  1834. ! to concentration in each of them
  1835. zda_i = a_i(ji,jj,jl) * zda_ex / MAX(at_i(ji,jj),epsi06) * zindb
  1836. ! Correction of limupdate after Antoine Barthélemy
  1837. ! Indeed the volume should not be changed.
  1838. !! zdv_i = v_i(ji,jj,jl) * zda_i / MAX(at_i(ji,jj),epsi06)
  1839. ! We take out the excess of ice and put it as volume
  1840. a_i(ji,jj,jl) = a_i(ji,jj,jl) - zda_i
  1841. !! v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdv_i
  1842. END DO
  1843. END DO
  1844. END DO
  1845. WRITE(*,*), 'Leaving shrink_ice()'
  1846. END SUBROUTINE shrink_ice
  1847. SUBROUTINE record_ice()
  1848. USE my_variables
  1849. USE netcdf
  1850. IMPLICIT NONE
  1851. ! Dummy variables
  1852. INTEGER :: jl, jk
  1853. WRITE(*,*) 'Entering record_ice()'
  1854. WRITE(*,*) 'Recording the NetCDF'
  1855. ! 8.1 Record ice variables
  1856. ! We copy the input file and store everything into this copy
  1857. CALL system('cp -f '//trim(cfile_analysis_ice)//' '//trim(cfileout_ice) )
  1858. ierr = nf90_open(trim(cfileout_ice),nf90_Write,incid_ice_an_out)
  1859. IF (ierr .NE. nf90_noerr ) THEN
  1860. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file. Abort"
  1861. WRITE(*,*), TRIM(cfileout_ice)
  1862. STOP
  1863. END IF
  1864. ! Loop over categories
  1865. ! (2024) Categories as dimension now, no need for the loop anymore.
  1866. ! I also change the var names to correspond with the current nemo restarts.
  1867. !DO jl = 1 , jpl
  1868. ! 8.1.1 a_i
  1869. !~~~~~~~~
  1870. cvarroot='a_i'
  1871. !WRITE(cinteger,'(i1)') jl
  1872. cvarname = TRIM(cvarroot)
  1873. WRITE(*,*), "Recording variable " // cvarname
  1874. ! Request variable ID
  1875. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1876. IF (ierr .NE. nf90_noerr ) THEN
  1877. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1878. WRITE(*,*), TRIM(cfileout_ice)
  1879. STOP
  1880. END IF
  1881. ! Put variable
  1882. ierr = nf90_put_var(incid_ice_an_out, ivarid, a_i)
  1883. IF (ierr .NE. nf90_noerr ) THEN
  1884. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  1885. WRITE(*,*), TRIM(cfileout_ice)
  1886. STOP
  1887. END IF
  1888. ! 8.1.2 v_i
  1889. !~~~~~~~~
  1890. cvarroot='v_i'
  1891. cvarname = TRIM(cvarroot)
  1892. WRITE(*,*), "Recording variable " // cvarname
  1893. ! Request variable ID
  1894. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1895. IF (ierr .NE. nf90_noerr ) THEN
  1896. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1897. WRITE(*,*), TRIM(cfileout_ice)
  1898. STOP
  1899. END IF
  1900. ! Put variable
  1901. ierr = nf90_put_var(incid_ice_an_out, ivarid, v_i)
  1902. IF (ierr .NE. nf90_noerr ) THEN
  1903. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  1904. WRITE(*,*), TRIM(cfileout_ice)
  1905. STOP
  1906. END IF
  1907. ! 8.1.3 v_s
  1908. !~~~~~~~~
  1909. cvarroot='v_s'
  1910. cvarname = TRIM(cvarroot)
  1911. WRITE(*,*), "Recording variable " // cvarname
  1912. ! Request variable ID
  1913. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1914. IF (ierr .NE. nf90_noerr ) THEN
  1915. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1916. WRITE(*,*), TRIM(cfileout_ice)
  1917. STOP
  1918. END IF
  1919. ! Put variable
  1920. ierr = nf90_put_var(incid_ice_an_out, ivarid, v_s)
  1921. IF (ierr .NE. nf90_noerr ) THEN
  1922. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  1923. WRITE(*,*), TRIM(cfileout_ice)
  1924. STOP
  1925. END IF
  1926. ! 8.1.4 smv_i
  1927. !~~~~~~~~~~
  1928. cvarroot='sv_i'
  1929. cvarname = TRIM(cvarroot)
  1930. WRITE(*,*), "Recording variable " // cvarname
  1931. ! Request variable ID
  1932. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1933. IF (ierr .NE. nf90_noerr ) THEN
  1934. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1935. WRITE(*,*), TRIM(cfileout_ice)
  1936. STOP
  1937. END IF
  1938. ! Put variable
  1939. ierr = nf90_put_var(incid_ice_an_out, ivarid, smv_i)
  1940. IF (ierr .NE. nf90_noerr ) THEN
  1941. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. smv_i put. Abort"
  1942. WRITE(*,*), TRIM(cfileout_ice)
  1943. STOP
  1944. END IF
  1945. ! 8.1.5 oa_i
  1946. ! ~~~~~~~~
  1947. cvarroot='oa_i'
  1948. cvarname = TRIM(cvarroot)
  1949. WRITE(*,*), "Recording variable " // cvarname
  1950. ! Request variable ID
  1951. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1952. IF (ierr .NE. nf90_noerr ) THEN
  1953. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1954. WRITE(*,*), TRIM(cfileout_ice)
  1955. STOP
  1956. END IF
  1957. ! Put variable
  1958. ierr = nf90_put_var(incid_ice_an_out, ivarid, oa_i)
  1959. IF (ierr .NE. nf90_noerr ) THEN
  1960. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  1961. WRITE(*,*), TRIM(cfileout_ice)
  1962. STOP
  1963. END IF
  1964. ! 8.1.6 t_su
  1965. ! ~~~~~~~~
  1966. cvarroot='t_su'
  1967. cvarname = TRIM(cvarroot)
  1968. WRITE(*,*), "Recording variable " // cvarname
  1969. ! Request variable ID
  1970. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1971. IF (ierr .NE. nf90_noerr ) THEN
  1972. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1973. WRITE(*,*), TRIM(cfileout_ice)
  1974. STOP
  1975. END IF
  1976. ! Put variable
  1977. ierr = nf90_put_var(incid_ice_an_out, ivarid, t_su)
  1978. IF (ierr .NE. nf90_noerr ) THEN
  1979. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  1980. WRITE(*,*), TRIM(cfileout_ice)
  1981. STOP
  1982. END IF
  1983. ! 8.1.7 Ice enthalpy (layers)
  1984. ! ~~~~~~~~~~~~~~~~~~~~~~~~~
  1985. cvarroot='e_i_l0'
  1986. DO jk = 1 , nlay_i
  1987. WRITE(cinteger2,'(i1)') jk
  1988. cvarname = TRIM(cvarroot) // TRIM(cinteger2)
  1989. WRITE(*,*),"Recording variable " // cvarname
  1990. ! Request variable ID
  1991. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  1992. IF (ierr .NE. nf90_noerr ) THEN
  1993. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  1994. WRITE(*,*), TRIM(cfileout_ice)
  1995. STOP
  1996. END IF
  1997. ! Put variable
  1998. ierr = nf90_put_var(incid_ice_an_out, ivarid, e_i(:,:,jk,:))
  1999. IF (ierr .NE. nf90_noerr ) THEN
  2000. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. e_i put. Abort"
  2001. WRITE(*,*), TRIM(cfileout_ice)
  2002. STOP
  2003. END IF
  2004. END DO !jk
  2005. ! 8.1.8 Snow enthalpy (layers)
  2006. ! ~~~~~~~~~~~~~~~~~~~~~~~~~
  2007. cvarroot='e_s_l0'
  2008. DO jk = 1 , nlay_s
  2009. WRITE(cinteger2,'(i1)') jk
  2010. cvarname = TRIM(cvarroot) // TRIM(cinteger2)
  2011. WRITE(*,*),"Recording variable " // cvarname
  2012. ! Request variable ID
  2013. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  2014. IF (ierr .NE. nf90_noerr ) THEN
  2015. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  2016. WRITE(*,*), TRIM(cfileout_ice)
  2017. STOP
  2018. END IF
  2019. ! Put variable
  2020. ierr = nf90_put_var(incid_ice_an_out, ivarid, e_s(:,:,jk,:))
  2021. IF (ierr .NE. nf90_noerr ) THEN
  2022. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. e_s put. Abort"
  2023. WRITE(*,*), TRIM(cfileout_ice)
  2024. STOP
  2025. END IF
  2026. END DO !jk
  2027. !END DO ! jl, categories
  2028. ! Put variables that don't depend on categories
  2029. ! Snow ice mass
  2030. ! Request variable id
  2031. cvarname = 'snwice_mass'
  2032. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  2033. IF (ierr .NE. nf90_noerr ) THEN
  2034. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  2035. WRITE(*,*), TRIM(cfileout_ice)
  2036. STOP
  2037. END IF
  2038. ! Put variable
  2039. ierr = nf90_put_var(incid_ice_an_out, ivarid, snwice_mass(:,:))
  2040. IF (ierr .NE. nf90_noerr ) THEN
  2041. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  2042. WRITE(*,*), TRIM(cfileout_ice)
  2043. STOP
  2044. END IF
  2045. cvarname = 'snwice_mass_b'
  2046. ierr = nf90_inq_varid(incid_ice_an_out, cvarname, ivarid)
  2047. IF (ierr .NE. nf90_noerr ) THEN
  2048. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. inquiry. Abort"
  2049. WRITE(*,*), TRIM(cfileout_ice)
  2050. STOP
  2051. END IF
  2052. ! Put variable
  2053. ierr = nf90_put_var(incid_ice_an_out, ivarid, snwice_mass_b(:,:))
  2054. IF (ierr .NE. nf90_noerr ) THEN
  2055. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF ice file var. put. Abort"
  2056. WRITE(*,*), TRIM(cfileout_ice)
  2057. STOP
  2058. END IF
  2059. ! Close the NetCDF file
  2060. ierr = nf90_close(incid_ice_an_out)
  2061. IF (ierr .NE. nf90_noerr ) THEN
  2062. WRITE(*,*), "(sanity_check_LIM3) Error Closing NetCDF . Abort"
  2063. WRITE(*,*), TRIM(cfileout_ice)
  2064. STOP
  2065. END IF
  2066. WRITE(*,*) 'Leaving record_ice()'
  2067. END SUBROUTINE record_ice
  2068. SUBROUTINE record_oce()
  2069. USE my_variables
  2070. USE netcdf
  2071. IMPLICIT NONE
  2072. WRITE(*,*) 'Entering record_oce()'
  2073. ! Record oce variables
  2074. ! We copy the input file and store everything into this copy
  2075. CALL system('cp -f '//trim(cfile_analysis_oce)//' '//trim(cfileout_oce) )
  2076. ! Open the file
  2077. ierr = nf90_open(trim(cfileout_oce),nf90_Write,incid_oce_an_out)
  2078. IF (ierr .NE. nf90_noerr ) THEN
  2079. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF Ocean file. Abort"
  2080. WRITE(*,*), TRIM(cfileout_oce)
  2081. STOP
  2082. END IF
  2083. ! A. sn (salinity)
  2084. cvarname= csn
  2085. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2086. IF (ierr .NE. nf90_noerr ) THEN
  2087. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2088. WRITE(*,*), TRIM(cfileout_oce)
  2089. STOP
  2090. END IF
  2091. ! Put variable
  2092. ierr = nf90_put_var(incid_oce_an_out, ivarid, sn_an(:,:,:))
  2093. IF (ierr .NE. nf90_noerr ) THEN
  2094. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2095. WRITE(*,*), TRIM(cfileout_oce)
  2096. STOP
  2097. END IF
  2098. ! Following lines commented out as the variable no longer appears
  2099. ! in the restart files (2020)
  2100. !! B. sss_m (sea surface salinity)
  2101. !cvarname= csss_m
  2102. !ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2103. !IF (ierr .NE. nf90_noerr ) THEN
  2104. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2105. ! WRITE(*,*), TRIM(cfileout_oce)
  2106. ! STOP
  2107. !END IF
  2108. !! Put variable
  2109. !ierr = nf90_put_var(incid_oce_an_out, ivarid, sss_m_an(:,:))
  2110. !IF (ierr .NE. nf90_noerr ) THEN
  2111. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2112. ! WRITE(*,*), TRIM(cfileout_oce)
  2113. ! STOP
  2114. !END IF
  2115. ! C. tn (temperature)
  2116. cvarname= ctn
  2117. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2118. IF (ierr .NE. nf90_noerr ) THEN
  2119. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2120. WRITE(*,*), TRIM(cfileout_oce)
  2121. STOP
  2122. END IF
  2123. ! Put variable
  2124. ierr = nf90_put_var(incid_oce_an_out, ivarid, tn_an(:,:,:))
  2125. IF (ierr .NE. nf90_noerr ) THEN
  2126. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2127. WRITE(*,*), TRIM(cfileout_oce)
  2128. STOP
  2129. END IF
  2130. ! Following lines commented out as the variable no longer appears
  2131. ! in the restart files (2020)
  2132. !! D. sst_m (sea surface temperature)
  2133. !cvarname= csst_m
  2134. !ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2135. !IF (ierr .NE. nf90_noerr ) THEN
  2136. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2137. ! WRITE(*,*), TRIM(cfileout_oce)
  2138. ! STOP
  2139. !END IF
  2140. !! Put variable
  2141. !ierr = nf90_put_var(incid_oce_an_out, ivarid, sst_m_an(:,:))
  2142. !IF (ierr .NE. nf90_noerr ) THEN
  2143. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2144. ! WRITE(*,*), TRIM(cfileout_oce)
  2145. ! STOP
  2146. !END IF
  2147. ! E. un (sea velocity, "un")
  2148. cvarname= cun
  2149. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2150. IF (ierr .NE. nf90_noerr ) THEN
  2151. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2152. WRITE(*,*), TRIM(cfileout_oce)
  2153. STOP
  2154. END IF
  2155. ! Put variable
  2156. ierr = nf90_put_var(incid_oce_an_out, ivarid, un_an(:,:,:))
  2157. IF (ierr .NE. nf90_noerr ) THEN
  2158. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2159. WRITE(*,*), TRIM(cfileout_oce)
  2160. STOP
  2161. END IF
  2162. ! F. ub (sea velocity, "ub")
  2163. cvarname= cub
  2164. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2165. IF (ierr .NE. nf90_noerr ) THEN
  2166. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2167. WRITE(*,*), TRIM(cfileout_oce)
  2168. STOP
  2169. END IF
  2170. ! Put variable
  2171. ierr = nf90_put_var(incid_oce_an_out, ivarid, ub_an(:,:,:))
  2172. IF (ierr .NE. nf90_noerr ) THEN
  2173. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2174. WRITE(*,*), TRIM(cfileout_oce)
  2175. STOP
  2176. END IF
  2177. ! G. vn (sea velocity, "vn")
  2178. cvarname= cvn
  2179. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2180. IF (ierr .NE. nf90_noerr ) THEN
  2181. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2182. WRITE(*,*), TRIM(cfileout_oce)
  2183. STOP
  2184. END IF
  2185. ! Put variable
  2186. ierr = nf90_put_var(incid_oce_an_out, ivarid, vn_an(:,:,:))
  2187. IF (ierr .NE. nf90_noerr ) THEN
  2188. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2189. WRITE(*,*), TRIM(cfileout_oce)
  2190. STOP
  2191. END IF
  2192. ! H. vb (sea velocity, "vb")
  2193. cvarname= cvb
  2194. ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2195. IF (ierr .NE. nf90_noerr ) THEN
  2196. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2197. WRITE(*,*), TRIM(cfileout_oce)
  2198. STOP
  2199. END IF
  2200. ! Put variable
  2201. ierr = nf90_put_var(incid_oce_an_out, ivarid, vb_an(:,:,:))
  2202. IF (ierr .NE. nf90_noerr ) THEN
  2203. WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2204. WRITE(*,*), TRIM(cfileout_oce)
  2205. STOP
  2206. END IF
  2207. ! Following lines commented out as the variable no longer appears
  2208. ! in the restart files (2020)
  2209. !! I. ssu_m (sea surface velocity, "ssu_m")
  2210. !cvarname= cssu_m
  2211. !ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2212. !IF (ierr .NE. nf90_noerr ) THEN
  2213. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2214. ! WRITE(*,*), TRIM(cfileout_oce)
  2215. ! STOP
  2216. !END IF
  2217. !
  2218. !! Put variable
  2219. !ierr = nf90_put_var(incid_oce_an_out, ivarid, ssu_m_an(:,:))
  2220. !IF (ierr .NE. nf90_noerr ) THEN
  2221. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2222. ! WRITE(*,*), TRIM(cfileout_oce)
  2223. ! STOP
  2224. !END IF
  2225. !
  2226. !! J. ssv_m (sea surface velocity, "ssv_m")
  2227. !cvarname= cssv_m
  2228. !ierr = nf90_inq_varid(incid_oce_an_out, cvarname, ivarid)
  2229. !IF (ierr .NE. nf90_noerr ) THEN
  2230. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. inquiry. Abort"
  2231. ! WRITE(*,*), TRIM(cfileout_oce)
  2232. ! STOP
  2233. !END IF
  2234. !
  2235. !! Put variable
  2236. !ierr = nf90_put_var(incid_oce_an_out, ivarid, ssv_m_an(:,:))
  2237. !IF (ierr .NE. nf90_noerr ) THEN
  2238. ! WRITE(*,*), "(sanity_check_LIM3) Error NetCDF oce file var. put. Abort"
  2239. ! WRITE(*,*), TRIM(cfileout_oce)
  2240. ! STOP
  2241. !END IF
  2242. ! Close file
  2243. ierr = nf90_close(incid_oce_an_out)
  2244. IF (ierr .NE. nf90_noerr ) THEN
  2245. WRITE(*,*), "(sanity_check_LIM3) Error Closing NetCDF . Abort"
  2246. WRITE(*,*), TRIM(cfileout_oce)
  2247. STOP
  2248. END IF
  2249. WRITE(*,*) 'Leaving record_oce'
  2250. END SUBROUTINE record_oce
  2251. SUBROUTINE salinity_check()
  2252. USE my_variables
  2253. USE netcdf
  2254. IMPLICIT NONE
  2255. ! Dummy variables
  2256. INTEGER :: ji, jj, jk
  2257. REAL :: zmaxsaldiff=9999.0
  2258. WRITE(*,*) 'Entering salinity_check() '
  2259. DO ji=1,jpi
  2260. DO jj=1,jpj
  2261. DO jk=1,jpk
  2262. zsaldiff=sn_an(ji,jj,jk) - sn_fc(ji,jj,jk)
  2263. IF (ABS(zsaldiff) .GT. zmaxsaldiff ) THEN
  2264. IF (ABS(zsaldiff) .GT. 100.0 * zmaxsaldiff ) THEN
  2265. WRITE(*,*) "Very large salinity variation"
  2266. WRITE(*,*) "at point ji,jj,jk = ", ji,jj,jk
  2267. WRITE(*,*) "sn_an is ",sn_an(ji,jj,jk)
  2268. WRITE(*,*) "sn_fc is ",sn_fc(ji,jj,jk)
  2269. WRITE(*,*) "diff is", zsaldiff
  2270. END IF
  2271. !WRITE(*,*) "Salinity difference at ji,jj,jk=",ji,jj,jk
  2272. !WRITE(*,*) "Difference is ",ABS(zsaldiff)
  2273. !WRITE(*,*) "sn_an is ",sn_an(ji,jj,jk)
  2274. !WRITE(*,*) "sn_fc is ",sn_fc(ji,jj,jk)
  2275. sn_an(ji,jj,jk) = sn_fc(ji,jj,jk) + SIGN(zmaxsaldiff,zsaldiff)
  2276. !WRITE(*,*) "sn_an is now ",sn_an(ji,jj,jk)
  2277. END IF
  2278. END DO ! jk
  2279. zsaldiff=(sss_m_an(ji,jj) - sss_m_fc(ji,jj)) / REAL( nn_fsbc - 1 )
  2280. IF (ABS(zsaldiff) .GT. zmaxsaldiff ) THEN
  2281. IF (ABS(zsaldiff) .GT. 100.0 * zmaxsaldiff ) THEN
  2282. WRITE(*,*) "Very large SSS variation at ji,jj = ",ji,jj
  2283. WRITE(*,*) "sss_m_an is ", sss_m_an(ji,jj)
  2284. WRITE(*,*) "sss_m_fc is ", sss_m_fc(ji,jj)
  2285. WRITE(*,*) "diff is" , zsaldiff
  2286. END IF
  2287. !WRITE(*,*) "Sea surface salinity difference at ji,jj=",ji,jj
  2288. !WRITE(*,*) "Difference is ",ABS(zsaldiff)
  2289. !WRITE(*,*) "sss_m_an is ",sss_m_an(ji,jj) / REAL( nn_fsbc - 1 )
  2290. !WRITE(*,*) "sss_m_fc is ",sss_m_fc(ji,jj) / REAL( nn_fsbc - 1 )
  2291. sss_m_an(ji,jj) = sss_m_fc(ji,jj) + SIGN(REAL( nn_fsbc - 1 ) * zmaxsaldiff , zsaldiff)
  2292. !WRITE(*,*) "sss_m_an is now ",sss_m_an(ji,jj) / REAL( nn_fsbc - 1 )
  2293. ! Important note
  2294. ! The reason for the nn_fsbc - 1 factor is the following. In the
  2295. ! restarts, the variable sss_m is (nn_fsbc -1) times the first layer of
  2296. ! the sea salinity, where nn_fsbc is the frequency call of the ice to
  2297. ! the ocean. As I understood, this is intended to facilitate the switch
  2298. ! from one frequency call to another. The point is that the variable
  2299. ! sss_m is the cumulative sea surface salinity over the (nn_fsbc-1) time
  2300. ! steps. Stated the other way around, it's nn_fsbc-1 times its mean
  2301. ! value. Hence here we divide sss_m by (nn_fsbc-1), ensure that
  2302. ! variations in salinity are not too strong, and give back the corrected
  2303. ! quantity multiplied by (nn_fsbc-1)
  2304. END IF
  2305. END DO
  2306. END DO
  2307. WRITE(*,*) 'Leaving salinity_check()'
  2308. END SUBROUTINE salinity_check
  2309. SUBROUTINE temperature_check()
  2310. USE my_variables
  2311. USE netcdf
  2312. IMPLICIT NONE
  2313. ! Dummy variables
  2314. INTEGER :: ji, jj, jk
  2315. REAL :: zmaxtempdiff=100.0
  2316. REAL :: ztempmin ! Minimum temperature for surf sea water (fct of salinity)
  2317. WRITE(*,*) 'Entering temperature_check() '
  2318. ! 3D- temperature
  2319. DO ji=1,jpi
  2320. DO jj=1,jpj
  2321. DO jk=1,jpk
  2322. ztempdiff=tn_an(ji,jj,jk) - tn_fc(ji,jj,jk)
  2323. IF (ABS(ztempdiff) .GT. zmaxtempdiff ) THEN
  2324. IF (ABS(ztempdiff) .GT. 100.0 * zmaxtempdiff ) THEN
  2325. WRITE(*,*) "Very large temperature variation detected!!"
  2326. WRITE(*,*) "at point ji,jj,jk = ", ji,jj,jk
  2327. WRITE(*,*) "tn_an is ",tn_an(ji,jj,jk)
  2328. WRITE(*,*) "tn_fc is ",tn_fc(ji,jj,jk)
  2329. END IF
  2330. !WRITE(*,*) "Temperature difference at ji,jj,jk=",ji,jj,jk
  2331. !WRITE(*,*) "Difference is ",ABS(ztempdiff)
  2332. !WRITE(*,*) "tn_an is ",tn_an(ji,jj,jk)
  2333. !WRITE(*,*) "tn_fc is ",tn_fc(ji,jj,jk)
  2334. tn_an(ji,jj,jk) = tn_fc(ji,jj,jk) + SIGN(zmaxtempdiff,ztempdiff)
  2335. !WRITE(*,*) "tn_an is now ",tn_an(ji,jj,jk)
  2336. END IF ! if diff is large
  2337. END DO ! jk
  2338. DO jk =1,1
  2339. ! Reset surface temperature to freezing point if below freezing point
  2340. ! This depends on the formulation chosen in the namelist (nn_eos).
  2341. ! The formula comes from the NEMO code (routine eosbn2.f90)
  2342. !
  2343. ! In the case nn_eos = 0 (UNESCO formulation)
  2344. ! ztempmin= ( - 0.0575_wp + 1.710523e-3_wp * SQRT( sn_an(ji,jj,jk) ) &
  2345. ! & - 2.154996e-4_wp * sn_an(ji,jj,jk) ) * sn_an(ji,jj,jk)
  2346. !
  2347. ! In the case nn_eos = -1 or 1 (TEOS-10 formulation)
  2348. r1_S0 = 0.875_wp/35.16504_wp
  2349. zs = sqrt( abs(sn_an(ji,jj,jk)) * r1_S0)
  2350. ztempmin = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
  2351. & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
  2352. ztempmin = ztempmin * sn_an(ji,jj,jk)
  2353. ! This is the freezing point of sea water at the surface.
  2354. IF ( tn_an(ji,jj,jk) .LT. ztempmin ) THEN
  2355. WRITE(*,*) 'At grid point ', ji,jj,jk
  2356. WRITE(*,*) 'tn_an reset from', tn_an(ji,jj,jk),'to ', ztempmin
  2357. tn_an(ji,jj,jk) = ztempmin
  2358. END IF
  2359. END DO ! jk
  2360. ! SST
  2361. ztempdiff=(sst_m_an(ji,jj) - sst_m_fc(ji,jj)) / REAL( nn_fsbc - 1 )
  2362. IF (ABS(ztempdiff) .GT. zmaxtempdiff ) THEN
  2363. IF (ABS(ztempdiff) .GT. 100.0 * zmaxtempdiff ) THEN
  2364. WRITE(*,*) "Very large SST variation deteced at ji,jj = ",ji,jj
  2365. WRITE(*,*) "sst_m_an is ", sst_m_an(ji,jj)
  2366. WRITE(*,*) "sst_m_fc is ", sst_m_fc(ji,jj)
  2367. WRITE(*,*) "diff is" , ztempdiff
  2368. END IF
  2369. !WRITE(*,*) "Sea surface temperature difference at ji,jj=",ji,jj
  2370. !WRITE(*,*) "Difference is ",ABS(ztempdiff)
  2371. !WRITE(*,*) "sst_m_an is ",sst_m_an(ji,jj) / REAL( nn_fsbc - 1 )
  2372. !WRITE(*,*) "sst_m_fc is ",sst_m_fc(ji,jj) / REAL( nn_fsbc - 1 )
  2373. sst_m_an(ji,jj) = sst_m_fc(ji,jj) + SIGN(REAL( nn_fsbc - 1 ) * zmaxtempdiff , ztempdiff)
  2374. !WRITE(*,*) "sst_m_an is now ",sst_m_an(ji,jj) / REAL( nn_fsbc - 1 )
  2375. ! Important note
  2376. ! The reason for the nn_fsbc - 1 factor is the following. In the
  2377. ! restarts, the variable sst_m is (nn_fsbc -1) times the first layer of
  2378. ! the sea temperature, where nn_fsbc is the frequency call of the ice to
  2379. ! the ocean. As I understood, this is intended to facilitate the switch
  2380. ! from one frequency call to another. The point is that the variable
  2381. ! sst_m is the cumulative sea surface temperature over the (nn_fsbc-1) time
  2382. ! steps. Stated the other way around, it's nn_fsbc-1 times its mean
  2383. ! value. Hence here we divide sst_m by (nn_fsbc-1), ensure that
  2384. ! variations in temperature are not too strong, and give back the corrected
  2385. ! quantity multiplied by (nn_fsbc-1)
  2386. END IF
  2387. ! For nn_eos = 0
  2388. ! ztempmin= ( - 0.0575_wp + 1.710523e-3_wp * SQRT( sn_an(ji,jj,1) ) &
  2389. ! & - 2.154996e-4_wp * sn_an(ji,jj,1) ) * sn_an(ji,jj,1)
  2390. ! For nn_eos = -1 or 1
  2391. r1_S0 = 0.875_wp/35.16504_wp
  2392. zs = sqrt( abs(sn_an(ji,jj,1)) * r1_S0)
  2393. ztempmin = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs &
  2394. & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp
  2395. ztempmin = ztempmin * sn_an(ji,jj,1)
  2396. IF ( ( sst_m_an(ji,jj) / REAL( nn_fsbc - 1 ) ) .LT. ztempmin ) THEN
  2397. WRITE(*,*), 'At grid point ', ji,jj
  2398. WRITE(*,*), 'SST reset from ',sst_m_an(ji,jj)/REAL( nn_fsbc - 1 ),' to ' ,ztempmin
  2399. sst_m_an(ji,jj) = ztempmin * REAL (nn_fsbc - 1)
  2400. END IF
  2401. END DO ! jj
  2402. END DO ! ji
  2403. WRITE(*,*) 'Leaving temperature_check()'
  2404. END SUBROUTINE temperature_check
  2405. SUBROUTINE update_hc()
  2406. USE my_variables
  2407. IMPLICIT NONE
  2408. INTEGER :: ji, jj, jk, jl
  2409. REAL(wp) :: zratio, ztmelts
  2410. REAL(wp), PARAMETER :: t_init = 270.0 ! Initial temperature of ice when it is forming. Inspired from limistate.
  2411. REAL(wp) :: zhc ! Heat content (in ice or snow)
  2412. REAL(wp), PARAMETER :: zunit_fac= 1.0e9! This 1.0e9 is because the e_i and e_s variables are saved in Giga Joules / m2 in
  2413. ! the restart (but in Joules/m2 in the code), I guess because the restart cannot take
  2414. ! numbers with large exponents.
  2415. ! For info: the energy to melt 1 meter of ice at 0°C is
  2416. ! 334 000 [J / kg] * 1 [m] * 1000 [kg/m3] = 0.334 x 10^9 J / m2
  2417. WRITE(*,*) 'Entering update_hc()'
  2418. DO jl = 1, jpl
  2419. DO ji = 1, jpi
  2420. DO jj = 1, jpj
  2421. ! Ice layers
  2422. ! Case 1: there was ice in the forecast
  2423. IF (v_i_fc(ji,jj,jl) .GT. epsi10) THEN
  2424. zratio = v_i(ji,jj,jl) / v_i_fc(ji,jj,jl)
  2425. ! Update the ice heat content by that amount in each layer
  2426. DO jk = 1, nlay_i
  2427. e_i(ji,jj,jk,jl) = zratio * e_i(ji,jj,jk,jl)
  2428. END DO ! jk
  2429. ! Case 2: there was no ice in the forecast
  2430. ELSEIF (v_i(ji,jj,jl) .GT. epsi06 ) THEN
  2431. ztmelts = - tmut * smv_i(ji,jj,jl) + rtt
  2432. zhc = zrhoic * (& ! [kg/m3]
  2433. &zcpic * (ztmelts - t_init)& ! [J/(kg.K) ] * [K ] = J/kg
  2434. &+zlfus* (1- (ztmelts - rtt)/(t_init-rtt) )& ! [J/kg]*[]
  2435. &-zrcp * (ztmelts - rtt)& ! [J/(kg.K)] * [K]
  2436. &)
  2437. ! zhc is in J/m3
  2438. ! The amount of heat in each layer is that divided by the number of
  2439. ! layers, multiplied by the sea ice volume (v_i*cell area) and by
  2440. ! unit_fac (see LIM3 code) to get the units in GigaJoule
  2441. DO jk = 1,nlay_i
  2442. e_i(ji,jj,jk,jl) = zhc * v_i(ji,jj,jl) * zcellarea(ji,jj) / nlay_i / zunit_fac
  2443. END DO
  2444. !WRITE(*,*) "Ice was created by the filter at point ", ji,jj
  2445. !WRITE(*,*) "Ice volume in forecast was",v_i_fc(ji,jj,jl)
  2446. !WRITE(*,*) "Ice volume in analysis is ",v_i(ji,jj,jl)
  2447. !WRITE(*,*) "In category ", jl
  2448. !WRITE(*,*) "New e_i is ",e_i(ji,jj,:,jl)
  2449. END IF
  2450. !IF ( ji ==127 .AND. jj == 124 .AND. jl==5 ) THEN
  2451. ! WRITE(*,*) "ji = ",ji,"jj = ",jj, "jl =", jl
  2452. ! WRITE(*,*) "e_i: ", e_i(ji,jj,:,jl)
  2453. ! WRITE(*,*) "zratio: ",zratio
  2454. ! WRITE(*,*) "v_i", v_i(ji,jj,jl)
  2455. ! WRITE(*,*) "v_i_fc: ", v_i_fc(ji,jj,jl)
  2456. ! WRITE(*,*) "Stop because requested so"
  2457. ! !STOP
  2458. !END IF
  2459. ! Snow layer
  2460. ! Case 1: there was snow in the forecast
  2461. IF (v_s_fc(ji,jj,jl) .GT. epsi06) THEN
  2462. zratio = v_s(ji,jj,jl) / v_s_fc(ji,jj,jl)
  2463. ! Update the ice heat content by that amount in each layer
  2464. DO jk = 1, nlay_s
  2465. e_s(ji,jj,jk,jl) = zratio * e_s(ji,jj,jk,jl)
  2466. END DO ! jk
  2467. ! Case 2: there was no snow in the forecast
  2468. ELSEIF (v_s(ji,jj,jl) .GT. epsi06) THEN
  2469. zhc = zrhosn * (& ! [kg/m3]
  2470. &zcpic * (rtt - t_init)& ! [J/(kg.K) ] * [K ] = J/kg
  2471. &+zlfus& ! [J/(kg)]
  2472. &)
  2473. ! zhc is in J/m3
  2474. ! The amount of heat in each layer is that divided by the number of
  2475. ! layers, multiplied by the snow volume (v_s*cell area)
  2476. DO jk = 1,nlay_s
  2477. e_s(ji,jj,jk,jl) = zhc * v_s(ji,jj,jl) * zcellarea(ji,jj) / nlay_s / zunit_fac
  2478. END DO
  2479. END IF
  2480. END DO! jj
  2481. END DO ! ji
  2482. END DO !jl
  2483. WRITE(*,*) 'Leaving update_hc()'
  2484. END SUBROUTINE update_hc
  2485. SUBROUTINE regularize()
  2486. USE my_variables
  2487. IMPLICIT NONE
  2488. INTEGER :: ji, jj, jk, jl
  2489. ! Resets < 0 concentrations to 0
  2490. ! Resets variables to zero where no ice concentration
  2491. DO ji=1,jpi
  2492. DO jj=1,jpj
  2493. DO jl =1,jpl
  2494. IF ( a_i(ji,jj,jl) .LT. rzero ) THEN
  2495. a_i( ji,jj,jl) = rzero
  2496. v_i( ji,jj,jl) = rzero
  2497. smv_i(ji,jj,jl) = rzero
  2498. v_s( ji,jj,jl) = rzero
  2499. oa_i( ji,jj,jl) = rzero
  2500. DO jk=1,nlay_i
  2501. e_i(ji,jj,jk,jl) = rzero
  2502. END DO
  2503. DO jk=1,nlay_s
  2504. e_s(ji,jj,jk,jl) = rzero
  2505. END DO
  2506. END IF
  2507. END DO
  2508. ! Variables that do not depend on categories
  2509. IF ( SUM(a_i(ji,jj,:)) .LT. rzero ) THEN
  2510. snwice_mass(ji,jj) = rzero
  2511. snwice_mass_b(ji,jj) = rzero
  2512. END IF
  2513. END DO!jj
  2514. END DO ! ji
  2515. END SUBROUTINE regularize
  2516. SUBROUTINE velocity_check()
  2517. USE my_variables
  2518. IMPLICIT NONE
  2519. INTEGER :: ji,jj,jk
  2520. REAL :: zmaxvel = 2.0
  2521. REAL :: zmaxsurfvel= 6.0
  2522. ! Resets ocean velocities to [-2,2] ms-1
  2523. ! Resets sea surface velocities to [-4,4] ms-1
  2524. DO ji=1,jpi
  2525. DO jj = 1,jpj
  2526. DO jk=1,jpk
  2527. IF ( ABS(un_an(ji,jj,jk)) .GT. zmaxvel ) THEN
  2528. WRITE(*,*) "Fast ocean found at ji,jj,jk=",ji,jj,jk
  2529. WRITE(*,*) "un_an is ",un_an(ji,jj,jk)
  2530. !un_an(ji,jj,jk) = un_fc(ji,jj,jk) !zmaxvel * SIGN( rone , un_an(ji,jj,jk) )
  2531. un_an(ji,jj,jk) = zmaxvel * SIGN( rone , un_an(ji,jj,jk) )
  2532. WRITE(*,*) "un_an reset to",un_an(ji,jj,jk)
  2533. END IF
  2534. IF ( ABS(ub_an(ji,jj,jk)) .GT. zmaxvel ) THEN
  2535. WRITE(*,*) "Fast ocean found at ji,jj,jk=",ji,jj,jk
  2536. WRITE(*,*) "ub_an is ",ub_an(ji,jj,jk)
  2537. !ub_an(ji,jj,jk) = ub_fc(ji,jj,jk) !zmaxvel * SIGN( rone , ub_an(ji,jj,jk) )
  2538. ub_an(ji,jj,jk) = zmaxvel * SIGN( rone , ub_an(ji,jj,jk) )
  2539. WRITE(*,*) "ub_an reset to",ub_an(ji,jj,jk)
  2540. END IF
  2541. IF ( ABS(vn_an(ji,jj,jk)) .GT. zmaxvel ) THEN
  2542. WRITE(*,*) "Fast ocean found at ji,jj,jk=",ji,jj,jk
  2543. WRITE(*,*) "vn_an is ",vn_an(ji,jj,jk)
  2544. !vn_an(ji,jj,jk) = vn_fc(ji,jj,jk) !zmaxvel * SIGN( rone , vn_an(ji,jj,jk) )
  2545. vn_an(ji,jj,jk) = zmaxvel * SIGN( rone , vn_an(ji,jj,jk) )
  2546. WRITE(*,*) "vn_an reset to",vn_an(ji,jj,jk)
  2547. END IF
  2548. IF ( ABS(vb_an(ji,jj,jk)) .GT. zmaxvel ) THEN
  2549. WRITE(*,*) "Fast ocean found at ji,jj,jk=",ji,jj,jk
  2550. WRITE(*,*) "vb_an is ",vb_an(ji,jj,jk)
  2551. !vb_an(ji,jj,jk) = vb_fc(ji,jj,jk) !zmaxvel * SIGN( rone , vb_an(ji,jj,jk) )
  2552. vb_an(ji,jj,jk) = zmaxvel * SIGN( rone , vb_an(ji,jj,jk) )
  2553. WRITE(*,*) "vb_an reset to",vb_an(ji,jj,jk)
  2554. END IF
  2555. END DO !jk
  2556. ! Surface velocity
  2557. IF (ABS(ssu_m_an(ji,jj)) .GT. zmaxsurfvel ) THEN
  2558. WRITE(*,*) "Fast sea surface velocity found at ji,jj=" , ji,jj
  2559. WRITE(*,*) "ssu_m_an is ",ssu_m_an(ji,jj)
  2560. !ssu_m_an(ji,jj) = ssu_m_fc(ji,jj) !zmaxsurfvel * SIGN(rone, ssu_m_an(ji,jj) )
  2561. ssu_m_an(ji,jj) = zmaxsurfvel * SIGN(rone, ssu_m_an(ji,jj) )
  2562. WRITE(*,*) "ssu_m_an reset to", ssu_m_an(ji,jj)
  2563. END IF
  2564. IF (ABS(ssv_m_an(ji,jj)) .GT. zmaxsurfvel ) THEN
  2565. WRITE(*,*) "Fast sea surface velocity found at ji,jj=" , ji,jj
  2566. WRITE(*,*) "ssv_m_an is ",ssv_m_an(ji,jj)
  2567. !ssv_m_an(ji,jj) = ssv_m_fc(ji,jj) !zmaxsurfvel * SIGN(rone, ssv_m_an(ji,jj) )
  2568. ssv_m_an(ji,jj) = zmaxsurfvel * SIGN(rone, ssv_m_an(ji,jj) )
  2569. WRITE(*,*) "ssv_m_an reset to", ssv_m_an(ji,jj)
  2570. END IF
  2571. END DO
  2572. END DO
  2573. END SUBROUTINE velocity_check