p_sanity_check.F90 91 KB

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