boundary.F90 86 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175
  1. #define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
  2. #define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
  3. #define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
  4. #include "tm5.inc"
  5. !-----------------------------------------------------------------------------
  6. ! TM5 !
  7. !-----------------------------------------------------------------------------
  8. !BOP
  9. !
  10. ! !MODULE: BOUNDARY
  11. !
  12. ! !DESCRIPTION: Set up boundary conditions:
  13. !
  14. ! O3, O3S and CH4 are relaxed to climatology at stratospheric layers
  15. !
  16. ! For O3 we use either
  17. ! CMIP6 ozone 3D mixing ratios 1850-2100 (Hegglin et al., in prep) or
  18. ! Multi Sensor Reanalysis v2
  19. ! Source MSR : www.temis.nl; Allaart, van der A, manuscript in preparation, 2009)
  20. ! Source MSR2: FIXME
  21. !
  22. ! For CH4 we use Climatology HALOE CH4, October 1991 to August 2002 by:
  23. ! Technical note: A stratospheric climatology for O3, H2O, CH4, NOx, HCl
  24. ! and HF derived from HALOE measurements by J.-U. Grooss and J. M.
  25. ! Russell III, Atmospheric Chemistry and Physics, 5, 2797-2807, 2005
  26. ! SRef-ID: 1680-7324/acp/2005-5-2797
  27. !
  28. ! HNO3 is prescribed at level lm using HNO3:03 ratios from ODIN (fallback on UARS).
  29. !
  30. ! CO is nudged using the ODIN ratio of CO/O3 @ 3 levels (JEW, 2014).
  31. !
  32. ! Note about ODIN datasets: a slow relaxation between monthly mean values
  33. ! is incorporated to improve on the large variability which exists between
  34. ! consecutive months (JEW, 2014).
  35. !\\
  36. !\\
  37. ! !INTERFACE:
  38. !
  39. MODULE BOUNDARY
  40. !
  41. ! !USES:
  42. !
  43. USE GO, ONLY : gol, goPr, goErr, goLabel
  44. USE TM5_DISTGRID, ONLY : dgrid, Get_DistGrid, gather, scatter_i_band
  45. USE DIMS, ONLY : nregions, idate
  46. USE chem_param, ONLY : ntracet
  47. USE global_types, ONLY : d23_data, d3_data
  48. USE Grid, ONLY : TLevelInfo
  49. #ifdef with_budgets
  50. USE budget_global, ONLY : nbudg, nbud_vg, nzon_vg, budg_dat
  51. #endif
  52. IMPLICIT NONE
  53. PRIVATE
  54. PUBLIC :: BOUNDARY_INIT, BOUNDARY_DONE, BOUNDARY_APPLY
  55. !
  56. ! !PUBLIC DATA MEMBERS:
  57. !
  58. LOGICAL, PUBLIC :: use_o3du
  59. TYPE(d23_data), PUBLIC :: o3du(nregions) ! optionally used in photolysis only
  60. LOGICAL, PUBLIC :: LCMIP6_CO2
  61. REAL, PUBLIC :: co2_glob
  62. !
  63. ! !PRIVATE DATA MEMBERS:
  64. !
  65. ! Flags for O3, CO and CH4 stratospheric nudging
  66. LOGICAL :: LCMIP6_O3, LCMIP6_CH4
  67. LOGICAL :: o3_piclim
  68. REAL, ALLOCATABLE :: weight_cmip62tm5(:)
  69. INTEGER, ALLOCATABLE :: jlow_cmip62tm5(:)
  70. LOGICAL :: use_MSR
  71. LOGICAL :: use_HALOE
  72. LOGICAL :: use_ODIN
  73. LOGICAL :: emis_ch4_single, emis_ch4_fix3d
  74. LOGICAL :: o3_fixyear, ch4_fixyear, co2_fixyear
  75. INTEGER :: o3_year, ch4_year, co2_year
  76. character(len=256) :: o3vmr_dirname
  77. character(len=256) :: o3du_dirname
  78. character(len=256) :: ch4vmr_dirname
  79. character(len=256) :: covmr_dirname
  80. character(len=256) :: cmip6_ch4_dirname_strat
  81. character(len=256) :: cmip6_co2_dirname
  82. ! Volume Mixing Ratio and Ratio, and values in DU
  83. TYPE(d23_data) :: o3vmrpm(nregions)
  84. TYPE(d23_data) :: o3vmr(nregions)
  85. TYPE(d23_data) :: o3vmrnm(nregions)
  86. TYPE(d23_data) :: ch4vmrpm(nregions)
  87. TYPE(d23_data) :: ch4vmr(nregions)
  88. TYPE(d23_data) :: ch4vmrnm(nregions)
  89. TYPE(d23_data) :: o3ratpm(nregions)
  90. TYPE(d23_data) :: o3rat(nregions)
  91. TYPE(d23_data) :: o3ratnm(nregions)
  92. TYPE(d23_data) :: ch4ratpm(nregions)
  93. TYPE(d23_data) :: ch4rat(nregions)
  94. TYPE(d23_data) :: ch4ratnm(nregions)
  95. TYPE(d23_data) :: odin_hno3_o3(nregions) ! hno3/o3 ratio at 4 pressure levels
  96. TYPE(d23_data) :: odin_hno3_o3_pm(nregions) ! hno3/o3 ratio at 4 pressure levels (previous month)
  97. TYPE(d23_data) :: odin_hno3_o3_nm(nregions) ! hno3/o3 ratio at 4 pressure levels (next month)
  98. TYPE(d23_data) :: odin_co_o3(nregions) ! co/o3 ratio at 4 pressure levels
  99. TYPE(d23_data) :: odin_co_o3_pm(nregions) ! co/o3 ratio at 4 pressure levels (previous month)
  100. TYPE(d23_data) :: odin_co_o3_nm(nregions) ! co/o3 ratio at 4 pressure levels (next month)
  101. TYPE(TLevelInfo) :: LeviX_msr, LeviX_haloe, LeviX_cmip6_o3
  102. real, allocatable :: wrk2d_ML(:,:) ! 2D work array, model levels
  103. real, allocatable :: wrk2d_4L(:,:) ! 2D work array, 4 levels
  104. real, allocatable :: wrk3dpm_ML(:,:,:), wrk3d_ML(:,:,:), wrk3dnm_ML(:,:,:)! 3D work array, model levels
  105. real, allocatable :: wrk3dratio(:,:,:)
  106. real, allocatable :: wrk3dratiopm(:,:,:) ! for smoothing CO and HNO3 values at monthly scale
  107. real, allocatable :: wrk3drationm(:,:,:) ! for smoothing CO and HNO3 values at monthly scale
  108. #ifdef with_budgets
  109. ! REAL, DIMENSION(nregions) :: sum_stratosphere
  110. REAL, PUBLIC :: budstratg(nbudg, nbud_vg, ntracet)
  111. #endif
  112. integer :: itim_init, itim_appl ! Timers id
  113. CHARACTER(len=*), PARAMETER :: mname = 'boundary'
  114. !
  115. ! !REVISION HISTORY:
  116. ! 15 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  117. ! 03 Mar 2014 - J. E. Williams - added nudging for CO from ODIN measurements
  118. ! Dec 2016 - Mar 2017 - T. van Noije - added options for using CMIP6 data sets
  119. ! for O3, CH4, and CO2
  120. !
  121. ! !REMARKS:
  122. ! (1) All reference to sum_stratosphere have been commented, since the
  123. ! variable is neither printed nor saved nor used to compute something
  124. ! else.
  125. !EOP
  126. !------------------------------------------------------------------------
  127. CONTAINS
  128. !--------------------------------------------------------------------------
  129. ! TM5 !
  130. !--------------------------------------------------------------------------
  131. !BOP
  132. !
  133. ! !IROUTINE: BOUNDARY_INIT
  134. !
  135. ! !DESCRIPTION: Act as both INIT and MONTHLY_UPDATE methods.
  136. !
  137. ! As INIT : read settings from rc file & allocate data.
  138. ! As MONTHLY_UPDATE : read data in.
  139. !
  140. ! Called at run start and at start of every month (from
  141. ! sources_sinks/sources_sinks_init & ss_monthly_update).
  142. !\\
  143. !\\
  144. ! !INTERFACE:
  145. !
  146. SUBROUTINE BOUNDARY_INIT( first, status )
  147. !
  148. ! !USES:
  149. !
  150. USE GO, ONLY : TrcFile, Init, Done, ReadRc
  151. USE GO, ONLY : GO_Timer_Def, GO_Timer_End, GO_Timer_Start
  152. USE dims, ONLY : im, jm, lm, lme, okdebug, idate, iglbsfc
  153. USE dims, ONLY : nregions, nlat180, nlon360
  154. USE dims, ONLY : newyr
  155. USE global_data, ONLY : rcfile, inputdir
  156. USE partools, ONLY : isRoot, par_broadcast
  157. USE MDF, ONLY : MDF_Open, MDF_HDF4, MDF_NETCDF, MDF_READ, MDF_Inq_VarID, MDF_Get_Var, MDF_Close
  158. USE binas, ONLY : p0
  159. USE Grid, ONLY : FillGrid, Fill3D, FillLevels
  160. USE Grid, ONLY : TLevelInfo
  161. USE Grid, ONLY : TllGridInfo, Init
  162. USE MeteoData, ONLY : global_lli, lli_z, levi
  163. !
  164. ! !INPUT PARAMETERS:
  165. !
  166. LOGICAL, INTENT(in) :: first ! is a new run
  167. !
  168. ! !OUTPUT PARAMETERS:
  169. !
  170. INTEGER, INTENT(out) :: status
  171. !
  172. ! !REVISION HISTORY:
  173. ! 13 Dec 2010 - P. Le Sager - bug fix in reading o3du : use correct
  174. ! number of levels to read data, and allow vertical
  175. ! regridding of O3du.
  176. ! 23 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  177. ! - fixed : now run longer than a month have correct boundary
  178. !
  179. !EOP
  180. !------------------------------------------------------------------------
  181. !BOC
  182. CHARACTER(len=*), PARAMETER :: rname = mname//'/Boundary_Init'
  183. INTEGER, PARAMETER :: avg_field = 1
  184. INTEGER, DIMENSION(2), PARAMETER :: msr2_valid = (/1979, 2015/) ! 2013-15 are GOME2 data
  185. INTEGER, PARAMETER :: nlon_cmip6_o3 = 144
  186. INTEGER, PARAMETER :: nlat_cmip6_o3 = 96
  187. INTEGER, PARAMETER :: nlev_cmip6_o3 = 66
  188. REAL, ALLOCATABLE :: a_cmip6_o3(:),b_cmip6_o3(:)
  189. REAL, ALLOCATABLE :: lat_cmip6_o3(:)
  190. CHARACTER(len=9) :: rgtype
  191. TYPE(TrcFile) :: rcF
  192. character(len=256) :: o3vmr_fnamepm, o3vmr_fname, o3vmr_fnamenm, o3du_fname
  193. character(len=256) :: ch4vmr_fnamepm, ch4vmr_fname, ch4vmr_fnamenm
  194. CHARACTER(len=256) :: filemon
  195. CHARACTER(len=4) :: ecstring
  196. INTEGER :: nmw, i1, i2, j2, j1, hid, varid
  197. INTEGER :: i,j,lmr, inp_levs, k
  198. INTEGER :: valid_year_pm, valid_year, valid_year_nm
  199. REAL*4 :: field3d_r4(nlat180,4,12)
  200. INTEGER :: nm, pm
  201. TYPE(TLevelInfo) :: src_lev
  202. ! some arrays on 1x1 resolution
  203. REAL, ALLOCATABLE :: field3d_pm(:,:,:), field3d(:,:,:), field3d_nm(:,:,:), field3d_h(:,:,:)
  204. REAL, ALLOCATABLE :: sp_z(:,:)
  205. ! CMIP6 ozone fields
  206. REAL, ALLOCATABLE :: field4d_cmip6_h(:,:,:,:)
  207. REAL, ALLOCATABLE :: field3d_cmip6_pm(:,:), field3d_cmip6(:,:), field3d_cmip6_nm(:,:)
  208. REAL :: tm5_lat
  209. INTEGER :: j_cmip6, jlow_cmip6
  210. INTEGER :: l ! TESTING ONLY
  211. ! Scale factors for stratospheric CH4 from HALOE
  212. real :: ch4_scale, ch4_scale_pm, ch4_scale_nm
  213. real :: ch4_ref
  214. integer :: iyear, target_year
  215. ! CMIP6 global annual mean mixing ratios for CH4 and CO2
  216. real*4, allocatable :: ch4_hist(:,:), ch4_sce(:,:), co2_hist(:,:), co2_sce(:,:)
  217. character(len=512) :: ch4_hist_fname, ch4_sce_fname, co2_hist_fname, co2_sce_fname
  218. !
  219. ! Scaling on HALOE climatology from 2000
  220. !
  221. REAL,Dimension(37) :: RCP6_CH4_STRAT ! covers 1999-2035
  222. data RCP6_CH4_STRAT /1.00, 1.00, 1.0043444078, 1.0099155518, 1.0159814566, 1.021545823, 1.0269678609, 1.032430564, &
  223. 1.037717051, 1.0432000868, 1.0489868922, 1.0547802041, 1.0604597888, 1.0660828758, &
  224. 1.071659984, 1.0772118797, 1.0827461809, 1.0882515012, 1.0937098125, 1.0991152047, &
  225. 1.1044713649, 1.1097834167, 1.1150356906, 1.1202446152, 1.1254644653, 1.1307196942, &
  226. 1.1360154799, 1.1413492741, 1.146701693, 1.1520482561, 1.1573782007, 1.1626917436, &
  227. 1.1679937104, 1.1733492199, 1.1788363765, 1.1844880647, 1.1903212557/
  228. ! --- begin ----------------------------------------
  229. CALL goLabel(rname)
  230. !--------------------------------------------------
  231. ! ** TRUE INIT : only once
  232. !--------------------------------------------------
  233. IF ( FIRST ) THEN
  234. ! read settings from rcfile:
  235. CALL Init( rcF, rcfile, status )
  236. IF_NOTOK_RETURN(status=1)
  237. CALL ReadRc( rcF, 'input.conc.o3.cmip6', LCMIP6_O3, status, default=.FALSE. )
  238. IF_ERROR_RETURN(status=1)
  239. IF (LCMIP6_O3) THEN
  240. write(gol,*) 'Stratospheric O3 based on CMIP6 mixing ratios'; call goPr
  241. CALL ReadRc( rcF, 'input.conc.o3.cmip6.dir', o3vmr_dirname, status )
  242. IF_NOTOK_RETURN(status=1)
  243. CALL ReadRc( rcF, 'input.conc.o3.cmip6.piclim', o3_piclim, status, default=.FALSE. )
  244. IF_ERROR_RETURN(status=1)
  245. IF (o3_piclim) THEN
  246. write(gol,*) 'Stratospheric O3 nudged to pre-industrial climatology from CMIP6'; call goPr
  247. ENDIF
  248. ENDIF
  249. CALL ReadRc( rcF, 'input.climat.MSR', use_MSR, status, default=.FALSE. )
  250. IF_ERROR_RETURN(status=1)
  251. IF (use_MSR) THEN
  252. CALL ReadRc( rcF, 'input.climat.o3vmr', o3vmr_dirname, status )
  253. IF_NOTOK_RETURN(status=1)
  254. CALL ReadRc( rcF, 'input.climat.use_o3du', use_o3du, status, default=.FALSE. )
  255. IF_ERROR_RETURN(status=1)
  256. IF (use_o3du) THEN
  257. CALL ReadRc( rcF, 'input.climat.o3du', o3du_dirname, status )
  258. IF_NOTOK_RETURN(status=1)
  259. ENDIF
  260. ENDIF
  261. IF (LCMIP6_O3 .and. use_MSR) THEN
  262. write (gol,'("ERROR - CMIP6 and MSR O3 cannot both be selected")') ; call goErr
  263. status=1; TRACEBACK; return
  264. ENDIF
  265. ! It is now possible to nudge stratospheric O3 mixing ratios
  266. ! to the fields for a fixed year,
  267. ! both for the CMIP6 and MSR data sets.
  268. CALL ReadRc( rcF, 'input.o3.fixyear', o3_fixyear, status, default = .FALSE. )
  269. IF_ERROR_RETURN(status=1)
  270. IF (o3_fixyear) THEN
  271. CALL ReadRc( rcF, 'input.o3.year', o3_year, status )
  272. IF_NOTOK_RETURN(status=1)
  273. IF (LCMIP6_O3) THEN
  274. IF (.not.o3_piclim) THEN
  275. write(gol,*) 'Stratospheric O3 nudged to fixed year: ', o3_year; call goPr
  276. ENDIF
  277. ELSE IF (use_MSR) THEN
  278. ! o3_piclim not defined
  279. write(gol,*) 'Stratospheric O3 nudged to fixed year: ', o3_year; call goPr
  280. ENDIF
  281. ENDIF
  282. CALL ReadRc( rcF, 'input.climat.HALOE', use_HALOE, status, default=.FALSE. )
  283. IF_ERROR_RETURN(status=1)
  284. IF (use_HALOE) THEN
  285. CALL ReadRc( rcF, 'input.climat.ch4vmr', ch4vmr_dirname, status )
  286. IF_NOTOK_RETURN(status=1)
  287. ENDIF
  288. CALL ReadRc( rcF, 'input.conc.ch4.cmip6', LCMIP6_CH4, status, default=.TRUE. )
  289. IF_ERROR_RETURN(status=1)
  290. IF (LCMIP6_CH4) THEN
  291. write(gol,*) 'Stratospheric CH4 scaled based on CMIP6 surface concentration'; call goPr
  292. CALL ReadRc( rcF, 'input.conc.ch4.cmip6.dir.year', cmip6_ch4_dirname_strat, status )
  293. IF_NOTOK_RETURN(status=1)
  294. IF (.not.use_HALOE) THEN
  295. write (gol,'("ERROR - The HALOE stratospheric CH4 climatology should be used with CMIP6 CH4")') ; call goErr
  296. status=1; TRACEBACK; return
  297. ENDIF
  298. ELSE
  299. CALL ReadRc( rcF, 'input.emis.ch4.single', emis_ch4_single, status )
  300. IF_NOTOK_RETURN(status=1)
  301. IF (emis_ch4_single) THEN
  302. call ReadRc( rcF, 'input.emis.ch4.fix3d', emis_ch4_fix3d, status, default=.true. )
  303. IF_NOTOK_RETURN(status=1)
  304. IF ( use_HALOE .and. emis_ch4_fix3d ) THEN
  305. write (gol,'("ERROR - Do not use the HALOE stratospheric CH4 climatology")') ; call goErr
  306. write (gol,'("ERROR - when a single mixing ratio is prescribed in the whole atmosphere")') ; call goErr
  307. status=1; TRACEBACK; return
  308. ENDIF
  309. ENDIF
  310. ENDIF
  311. CALL ReadRc( rcF, 'input.ch4.fixyear', ch4_fixyear, status, default = .FALSE. )
  312. IF_ERROR_RETURN(status=1)
  313. IF (ch4_fixyear) THEN
  314. CALL ReadRc( rcF, 'input.ch4.year', ch4_year, status )
  315. IF_NOTOK_RETURN(status=1)
  316. write(gol,*) 'Base year for stratospheric CH4 scaling: ', ch4_year; call goPr
  317. ENDIF
  318. CALL ReadRc( rcF, 'input.climat.ODIN', use_ODIN, status, default=.FALSE. )
  319. IF_ERROR_RETURN(status=1)
  320. IF (use_ODIN) THEN
  321. CALL ReadRc( rcF, 'input.climat.covmr', covmr_dirname, status )
  322. IF_NOTOK_RETURN(status=1)
  323. ENDIF
  324. CALL ReadRc( rcF, 'input.conc.co2.cmip6', LCMIP6_CO2, status, default=.TRUE. )
  325. IF_ERROR_RETURN(status=1)
  326. IF (LCMIP6_CO2) THEN
  327. write(gol,*) 'Global annual mean CO2 mixing ratios in pH calculation based on CMIP6'; call goPr
  328. CALL ReadRc( rcF, 'input.conc.co2.cmip6.dir', cmip6_co2_dirname, status )
  329. IF_NOTOK_RETURN(status=1)
  330. CALL ReadRc( rcF, 'input.co2.fixyear', co2_fixyear, status, default = .FALSE. )
  331. IF_ERROR_RETURN(status=1)
  332. IF (co2_fixyear) THEN
  333. CALL ReadRc( rcF, 'input.co2.year', co2_year, status )
  334. IF_NOTOK_RETURN(status=1)
  335. write(gol,*) 'CO2 mixing ratio fixed to year: ', co2_year; call goPr
  336. ENDIF
  337. ELSE
  338. ! It would be better to change this warning into an error
  339. write (gol,'("WARNING - CO2 mixing ratio in pH calculation fixed to global annual mean for year 2000")') ; call goPr
  340. write (gol,'("WARNING - It is recommended to use the CMIP6 time series")') ; call goPr
  341. ENDIF
  342. CALL Done( rcF, status )
  343. IF_NOTOK_RETURN(status=1)
  344. IF (isRoot) THEN
  345. IF (LCMIP6_O3) THEN
  346. allocate(a_cmip6_o3(0:nlev_cmip6_o3))
  347. allocate(b_cmip6_o3(0:nlev_cmip6_o3))
  348. allocate(lat_cmip6_o3(1:nlat_cmip6_o3))
  349. allocate(jlow_cmip62tm5(1:jm(1)))
  350. allocate(weight_cmip62tm5(1:jm(1)))
  351. ! CMIP6 fields are provided on a pressure grid spanning from 1000 hPa to 0.0001 hPa
  352. ! half-level pressure coefficient a (Pa)
  353. a_cmip6_o3(:) = 100. * &
  354. (/1037.5, 962.5, 887.5, 825.0, 790.0, 765.0, 725.0, 675.0, 625.0, 550.0, &
  355. 475.0, 425.0, 375.0, 325.0, 292.5, 267.5, 225.0, 185.0, 160.0, 140.0, &
  356. 122.5, 107.5, 95.0, 85.0, 75.0, 65.0, 55.0, 45.0, 37.5, 32.5, &
  357. 27.5, 22.5, 17.5, 12.5, 8.5, 6.0, 4.5, 3.5, 2.5, 1.75, &
  358. 1.25, 0.85, 0.6, 0.45, 0.35, 0.25, 0.175, 0.125, 0.085, 0.06, &
  359. 0.045, 0.035, 0.025, 0.0175, 0.0125, 0.0085, 0.006, 0.0045, 0.0035, 0.0025, &
  360. 0.00175, 0.00125, 0.0009, 0.00065, 0.0004, 0.0002, 0.0000 /)
  361. ! half-level pressure coefficient b
  362. b_cmip6_o3(:) = 0.
  363. CALL Init(LeviX_cmip6_o3, nlev_cmip6_o3, a_cmip6_o3, b_cmip6_o3, status)
  364. IF_NOTOK_RETURN(status=1)
  365. ! Calculate weights for interpolation
  366. ! from CMIP6 to model latitudes.
  367. ! Note that in IFS the Cartesian coordinate
  368. ! sin(lat) is used to linearly interpolate
  369. ! to the model's Gaussian grid
  370. ! (see e.g. cmip6_piaer_mxr_interp.F90).
  371. ! For the regular grid of TM5,
  372. ! it is more appropriate to use
  373. ! the latitude coordinate directly.
  374. ! The difference is negligible anyway.
  375. ! The alternative would be to impose
  376. ! local mass conservation,
  377. ! but that is not necessary here.
  378. lat_cmip6_o3(:) = &
  379. (/-90., -88.10526, -86.21053, -84.31579, -82.42105, -80.52631, -78.63158, &
  380. -76.73684, -74.8421 , -72.94736, -71.05264, -69.1579, -67.26316, &
  381. -65.36842, -63.47368, -61.57895, -59.68421, -57.78947, -55.89474, -54., &
  382. -52.10526, -50.21053, -48.31579, -46.42105, -44.52632, -42.63158, &
  383. -40.73684, -38.84211, -36.94737, -35.05263, -33.15789, -31.26316, &
  384. -29.36842, -27.47368, -25.57895, -23.68421, -21.78947, -19.89474, -18., &
  385. -16.10526, -14.21053, -12.31579, -10.42105, -8.526316, -6.631579, &
  386. -4.736842, -2.842105, -0.9473684, 0.9473684, 2.842105, 4.736842, &
  387. 6.631579, 8.526316, 10.42105, 12.31579, 14.21053, 16.10526, 18., 19.89474, &
  388. 21.78947, 23.68421, 25.57895, 27.47368, 29.36842, 31.26316, 33.15789, &
  389. 35.05263, 36.94737, 38.84211, 40.73684, 42.63158, 44.52632, 46.42105, &
  390. 48.31579, 50.21053, 52.10526, 54., 55.89474, 57.78947, 59.68421, 61.57895, &
  391. 63.47368, 65.36842, 67.26316, 69.1579, 71.05264, 72.94736, 74.8421, &
  392. 76.73684, 78.63158, 80.52631, 82.42105, 84.31579, 86.21053, 88.10526, 90./)
  393. jlow_cmip6 = 1
  394. DO j=1,jm(1)
  395. tm5_lat=lli_z(1)%lat_deg(j) ! lat in degrees
  396. ! Since CMIP6 mid-point latitudes run from -90 to +90,
  397. ! the target latitudes of the model always fall within this range
  398. DO j_cmip6=jlow_cmip6,nlat_cmip6_o3
  399. IF ( (tm5_lat .ge. lat_cmip6_o3(j_cmip6)) .and. &
  400. (tm5_lat .lt. lat_cmip6_o3(j_cmip6+1)) ) THEN
  401. jlow_cmip6 = j_cmip6
  402. EXIT
  403. ENDIF
  404. ENDDO
  405. jlow_cmip62tm5(j)=jlow_cmip6
  406. weight_cmip62tm5(j) = (tm5_lat - lat_cmip6_o3(jlow_cmip6)) / &
  407. (lat_cmip6_o3(jlow_cmip6+1) - lat_cmip6_o3(jlow_cmip6))
  408. ENDDO
  409. deallocate(a_cmip6_o3)
  410. deallocate(b_cmip6_o3)
  411. deallocate(lat_cmip6_o3)
  412. ENDIF
  413. IF (use_MSR) THEN
  414. ! Define vertical grid of MSR input files (MSR2 only on 60 levels)
  415. ecstring='ec60'
  416. CALL Init(LeviX_msr, ecstring, status)
  417. IF_NOTOK_RETURN(status=1)
  418. ENDIF
  419. IF (use_HALOE) THEN
  420. ! Define vertical grid of HALOE input files
  421. select case (lme)
  422. case(60)
  423. ! offline TM5 resolution
  424. ecstring='ec60'
  425. case(34, 91)
  426. ! standard EC-Earth3 resolution
  427. ecstring='ec91'
  428. case(40)
  429. ecstring='ec40'
  430. case(62)
  431. ecstring='ec62'
  432. case default
  433. write (gol,'("ERROR - HALOE input files not available for this vertical resolution")') ; call goErr
  434. status=1; TRACEBACK; return
  435. end select
  436. CALL Init(LeviX_haloe, ecstring, status)
  437. IF_NOTOK_RETURN(status=1)
  438. ENDIF
  439. ENDIF
  440. ! Allocate
  441. CALL Get_DistGrid( dgrid(1), J_STRT=j1, J_STOP=j2 ) ! grid size
  442. lmr = lm(1)
  443. IF (use_o3du) THEN
  444. ALLOCATE( o3du(1)%d23(j1:j2, lmr) )
  445. o3du(1)%d23 = 0.0
  446. END IF
  447. allocate( o3ratpm (1)%d23( j1:j2, lmr) )
  448. allocate( o3rat (1)%d23( j1:j2, lmr) )
  449. allocate( o3ratnm (1)%d23( j1:j2, lmr) )
  450. allocate( ch4ratpm (1)%d23( j1:j2, lmr) )
  451. allocate( ch4rat (1)%d23( j1:j2, lmr) )
  452. allocate( ch4ratnm (1)%d23( j1:j2, lmr) )
  453. allocate( odin_hno3_o3 (1)%d23( j1:j2, 4) )
  454. allocate( odin_hno3_o3_pm(1)%d23( j1:j2, 4) )
  455. allocate( odin_hno3_o3_nm(1)%d23( j1:j2, 4) )
  456. allocate( o3vmrpm (1)%d23( j1:j2, lmr) )
  457. allocate( o3vmr (1)%d23( j1:j2, lmr) )
  458. allocate( o3vmrnm (1)%d23( j1:j2, lmr) )
  459. allocate( ch4vmrpm (1)%d23( j1:j2, lmr) )
  460. allocate( ch4vmr (1)%d23( j1:j2, lmr) ) ! only if Haloe
  461. allocate( ch4vmrnm (1)%d23( j1:j2, lmr) )
  462. allocate( odin_co_o3 (1)%d23( j1:j2, 4) )
  463. allocate( odin_co_o3_pm(1)%d23( j1:j2, 4) )
  464. allocate( odin_co_o3_nm(1)%d23( j1:j2, 4) )
  465. ! work arrays
  466. IF (isRoot) THEN
  467. allocate( wrk3dpm_ML (1, jm(1), lmr) )
  468. allocate( wrk3d_ML (1, jm(1), lmr) )
  469. allocate( wrk3dnm_ML (1, jm(1), lmr) )
  470. allocate( wrk3dratio(1, jm(1), 4) )
  471. allocate( wrk3dratiopm(1, jm(1), 4) )
  472. allocate( wrk3drationm(1, jm(1), 4) )
  473. allocate( wrk2d_ML ( jm(1), lmr) )
  474. allocate( wrk2d_4L ( jm(1), 4) )
  475. ELSE
  476. allocate( wrk3dpm_ML (1,1,1) )
  477. allocate( wrk3d_ML (1,1,1) )
  478. allocate( wrk3dnm_ML (1,1,1) )
  479. allocate( wrk3dratio(1,1,1) )
  480. allocate( wrk3dratiopm(1,1,1) )
  481. allocate( wrk3drationm(1,1,1) )
  482. ALLOCATE( wrk2d_ML(1,1) )
  483. ALLOCATE( wrk2d_4L(1,1) )
  484. END IF
  485. ! safety
  486. o3ratpm(1)%d23 = 0.0 ; o3rat(1)%d23 = 0.0 ; o3ratnm(1)%d23 = 0.0
  487. ch4ratpm(1)%d23 = 0.0 ; ch4rat(1)%d23 = 0.0 ; ch4ratnm(1)%d23 = 0.0
  488. odin_hno3_o3_pm(1)%d23 = 0.0 ; odin_hno3_o3(1)%d23 = 0.0 ; odin_hno3_o3_nm(1)%d23 = 0.0
  489. odin_co_o3_pm(1)%d23 = 0.0 ; odin_co_o3 (1)%d23 = 0.0 ; odin_co_o3_nm(1)%d23 = 0.0
  490. ! Budgets init
  491. !--------------------------------------------------
  492. #ifdef with_budgets
  493. ! sum_stratosphere(1) = 0.0
  494. budstratg(:,:,:) = 0.0
  495. #endif
  496. ! Timers
  497. call GO_Timer_Def( itim_init, 'boundary init', status )
  498. IF_NOTOK_RETURN(status=1)
  499. call GO_Timer_Def( itim_appl, 'boundary appl', status )
  500. IF_NOTOK_RETURN(status=1)
  501. ELSE
  502. ! start timing
  503. call GO_Timer_Start( itim_init, status )
  504. IF_NOTOK_RETURN(status=1)
  505. !--------------------------------------------------
  506. ! ** OZONE CLIMATOLOGIES
  507. !--------------------------------------------------
  508. !--------------------------------------------------
  509. ! ** o3 vmr
  510. !--------------------------------------------------
  511. ROOT : IF (isRoot) THEN
  512. IF (LCMIP6_O3) THEN
  513. ! CMIP6 ozone files
  514. ! containing float vmro3(time, plev, lat, lon)
  515. ! with 14 months
  516. allocate( field4d_cmip6_h(nlon_cmip6_o3, nlat_cmip6_o3, nlev_cmip6_o3,3) )
  517. allocate( field3d_cmip6_pm (nlat_cmip6_o3, nlev_cmip6_o3) )
  518. allocate( field3d_cmip6 (nlat_cmip6_o3, nlev_cmip6_o3) )
  519. allocate( field3d_cmip6_nm (nlat_cmip6_o3, nlev_cmip6_o3) )
  520. allocate( field3d_pm (1, jm(1), nlev_cmip6_o3) )
  521. allocate( field3d (1, jm(1), nlev_cmip6_o3) )
  522. allocate( field3d_nm (1, jm(1), nlev_cmip6_o3) )
  523. if (o3_piclim) then
  524. ! pre-industrial control using 1850 O3 climatology
  525. write(o3vmr_fname,'(a,a,i4,a)') TRIM(o3vmr_dirname),'vmro3_input4MIPs_ozone_CMIP6_UReading-CCMI_clim_1850.nc'
  526. else
  527. if (.not.o3_fixyear) then
  528. target_year = MIN(2100,MAX(idate(1),1850))
  529. else
  530. target_year = MIN(2100,MAX(o3_year,1850))
  531. endif
  532. ! To prevent problems with the last entry,
  533. ! containing the field for January 2015,
  534. ! O3 data are read from the scenario files
  535. ! already when the target_year is 2014.
  536. if ( target_year .gt. 2013 ) then
  537. write (gol,'("ERROR - Nudging of stratospheric O3 mixing ratios")') ; call goPr
  538. write (gol,'("ERROR - not implemented yet for CMIP6 scenarios")') ; call goErr
  539. status=1; TRACEBACK; return
  540. ! include case statement to use different filename for each scenario
  541. write(o3vmr_fname,'(a,a,i4,a)') TRIM(o3vmr_dirname),'xxxvmro3_input4MIPs_ozone_CMIP6_UReading-CCMI_',target_year,'.nc'
  542. else
  543. write(o3vmr_fname,'(a,a,i4,a)') TRIM(o3vmr_dirname),'vmro3_input4MIPs_ozone_CMIP6_UReading-CCMI_',target_year,'.nc'
  544. endif
  545. endif
  546. CALL MDF_Open( TRIM(o3vmr_fname), MDF_NETCDF, MDF_READ, hid, status )
  547. IF_NOTOK_RETURN(status=1)
  548. CALL MDF_Inq_VarID( hid,'vmro3', varid, status )
  549. IF_NOTOK_RETURN(status=1)
  550. ! Ozone input files contain 14 month entries,
  551. ! 1: December previous year
  552. ! 2-13: January to December current year
  553. ! 14: January next year
  554. ! Besides the current month,
  555. ! also the previous and next month are needed.
  556. ! By default, these have indices idate(2), idate(2)+1, and idate(2)+2.
  557. CALL MDF_Get_Var( hid, varid, field4d_cmip6_h, status, start=(/1,1,1,idate(2)/), count=(/nlon_cmip6_o3,nlat_cmip6_o3,nlev_cmip6_o3,3/) )
  558. IF_NOTOK_RETURN(status=1)
  559. ! When a fixed year is used for O3
  560. ! information from the previous or next year
  561. ! should not be used and overwritten
  562. ! with the data for the target year.
  563. ! This is not necessary
  564. ! when the pre-industrial climatology is used.
  565. IF (o3_fixyear .and. .not.o3_piclim) THEN
  566. IF (idate(2).eq.1) THEN
  567. ! overwrite previous month with field for December of the target year
  568. CALL MDF_Get_Var( hid, varid, field4d_cmip6_h(:,:,:,1), status, start=(/1,1,1,13/), count=(/nlon_cmip6_o3,nlat_cmip6_o3,nlev_cmip6_o3,1/) )
  569. ELSE IF (idate(2).eq.12) THEN
  570. ! overwrite next month with field for January of the current year
  571. CALL MDF_Get_Var( hid, varid, field4d_cmip6_h(:,:,:,3), status, start=(/1,1,1,2/), count=(/nlon_cmip6_o3,nlat_cmip6_o3,nlev_cmip6_o3,1/) )
  572. ENDIF
  573. ENDIF
  574. CALL MDF_Close( hid, status )
  575. IF_NOTOK_RETURN(status=1)
  576. ! calculate zonal mean
  577. DO k=1,nlev_cmip6_o3
  578. DO j=1,nlat_cmip6_o3
  579. field3d_cmip6_pm(j,k)= sum(field4d_cmip6_h(:,j,k,1))/float(nlon_cmip6_o3)
  580. field3d_cmip6(j,k) = sum(field4d_cmip6_h(:,j,k,2))/float(nlon_cmip6_o3)
  581. field3d_cmip6_nm(j,k)= sum(field4d_cmip6_h(:,j,k,3))/float(nlon_cmip6_o3)
  582. ENDDO
  583. ENDDO
  584. deallocate( field4d_cmip6_h )
  585. DO j=1,jm(1)
  586. jlow_cmip6=jlow_cmip62tm5(j)
  587. field3d_pm(1,j,:) = &
  588. field3d_cmip6_pm(jlow_cmip6,:) + weight_cmip62tm5(j) * &
  589. ( field3d_cmip6_pm(jlow_cmip6+1,:) - field3d_cmip6_pm(jlow_cmip6,:) )
  590. field3d(1,j,:) = &
  591. field3d_cmip6(jlow_cmip6,:) + weight_cmip62tm5(j) * &
  592. ( field3d_cmip6(jlow_cmip6+1,:) - field3d_cmip6(jlow_cmip6,:) )
  593. field3d_nm(1,j,:) = &
  594. field3d_cmip6_nm(jlow_cmip6,:) + weight_cmip62tm5(j) * &
  595. ( field3d_cmip6_nm(jlow_cmip6+1,:) - field3d_cmip6_nm(jlow_cmip6,:) )
  596. ENDDO
  597. deallocate (field3d_cmip6_pm)
  598. deallocate (field3d_cmip6)
  599. deallocate (field3d_cmip6_nm)
  600. ! convert from mol/mol to ppmv,
  601. ! the unit used in the MSR input files
  602. field3d_pm = 1.e6 * field3d_pm
  603. field3d = 1.e6 * field3d
  604. field3d_nm = 1.e6 * field3d_nm
  605. ! Distribute to model vertical resolution
  606. src_lev = leviX_cmip6_o3
  607. rgtype = 'mass-aver'
  608. ALLOCATE( sp_z(1,jm(1)) ) ! dummy surface pressure:
  609. sp_z = p0 ! 1e5 Pa
  610. CALL FillLevels( levi, 'n', sp_z, wrk3dpm_ML, &
  611. src_lev, field3d_pm, rgtype, status )
  612. CALL FillLevels( levi, 'n', sp_z, wrk3d_ML, &
  613. src_lev, field3d, rgtype, status )
  614. CALL FillLevels( levi, 'n', sp_z, wrk3dnm_ML, &
  615. src_lev, field3d_nm, rgtype, status )
  616. ELSE
  617. IF (use_MSR) THEN
  618. inp_levs = LeviX_msr%nlev
  619. allocate( field3D_pm (1, nlat180, inp_levs) )
  620. allocate( field3D (1, nlat180, inp_levs) )
  621. allocate( field3D_nm (1, nlat180, inp_levs) )
  622. allocate( field3d_h (1, nlat180, inp_levs) )
  623. field3d_pm=0.0 ; field3d=0.0 ; field3d_nm=0.0 ; field3d_h=0.0
  624. nmw=idate(2) ! pick out right month in file
  625. ! filename (includes year and nb of levels)
  626. if (.not.o3_fixyear) then
  627. valid_year = MIN(msr2_valid(2), MAX(idate(1), msr2_valid(1)))
  628. valid_year_pm = MAX(valid_year-1, msr2_valid(1))
  629. valid_year_nm = MIN(valid_year+1, msr2_valid(2))
  630. else
  631. valid_year = MIN(msr2_valid(2), MAX(o3_year, msr2_valid(1)))
  632. valid_year_pm = valid_year
  633. valid_year_nm = valid_year
  634. endif
  635. ! Currently available: 1979-2012
  636. WRITE(o3vmr_fnamepm,'(a,"msr2_o3vmr",i4,"_",i2,".hdf")')TRIM(o3vmr_dirname),valid_year_pm,inp_levs
  637. WRITE(o3vmr_fname,' (a,"msr2_o3vmr",i4,"_",i2,".hdf")')TRIM(o3vmr_dirname),valid_year, inp_levs
  638. WRITE(o3vmr_fnamenm,'(a,"msr2_o3vmr",i4,"_",i2,".hdf")')TRIM(o3vmr_dirname),valid_year_nm,inp_levs
  639. !
  640. ! January
  641. !
  642. if(nmw .eq. 1) then
  643. CALL MDF_Open( TRIM(o3vmr_fnamepm), MDF_HDF4, MDF_READ, hid, status )
  644. IF_NOTOK_RETURN(status=1)
  645. CALL MDF_Inq_VarID( hid, 'ozone12', varid, status )
  646. IF_NOTOK_RETURN(status=1)
  647. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  648. IF_NOTOK_RETURN(status=1)
  649. CALL MDF_Close( hid, status )
  650. IF_NOTOK_RETURN(status=1)
  651. ! Flip the data over (upside down), since leviX_msr, associated with
  652. ! field3d when regridding below (Fill3D), is flipped w/r/t to levi
  653. ! [it is the case, since ecstring starts with "ec" and not "tm"
  654. ! --see grid_type_hyb.F90--]
  655. DO k=1,inp_levs
  656. field3d_pm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  657. ENDDO
  658. CALL MDF_Open( TRIM(o3vmr_fname), MDF_HDF4, MDF_READ, hid, status )
  659. IF_NOTOK_RETURN(status=1)
  660. CALL MDF_Inq_VarID( hid, 'ozone1', varid, status )
  661. IF_NOTOK_RETURN(status=1)
  662. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  663. IF_NOTOK_RETURN(status=1)
  664. DO k=1,inp_levs
  665. field3d(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  666. ENDDO
  667. CALL MDF_Inq_VarID( hid, 'ozone2', varid, status )
  668. IF_NOTOK_RETURN(status=1)
  669. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  670. IF_NOTOK_RETURN(status=1)
  671. CALL MDF_Close( hid, status )
  672. IF_NOTOK_RETURN(status=1)
  673. DO k=1,inp_levs
  674. field3d_nm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  675. ENDDO
  676. src_lev = leviX_msr
  677. rgtype = 'mass-aver'
  678. deallocate( field3d_h )
  679. endif
  680. !
  681. ! Here the previous and next monthly fields are located in the same year
  682. !
  683. if(nmw .gt. 1 .and. nmw .lt. 12) then
  684. ! field name (has month: ozone1, ozone2, ..., ozone12)
  685. IF (nmw.LT.11) THEN
  686. nmw=idate(2)-1
  687. WRITE(filemon,'(a,i1)')'ozone',nmw
  688. ELSE
  689. nmw=idate(2)-1
  690. WRITE(filemon,'(a,i2)')'ozone',nmw
  691. ENDIF
  692. CALL MDF_Open( TRIM(o3vmr_fname), MDF_HDF4, MDF_READ, hid, status )
  693. IF_NOTOK_RETURN(status=1)
  694. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  695. IF_NOTOK_RETURN(status=1)
  696. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  697. IF_NOTOK_RETURN(status=1)
  698. ! Flip the data over (upside down), since leviX_msr, associated with
  699. ! field3d when regridding below (Fill3D), is flipped w/r/t to levi
  700. ! [it is the case, since ecstring starts with "ec" and not "tm"
  701. ! --see grid_type_hyb.F90--]
  702. DO k=1,inp_levs
  703. field3d_pm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  704. ENDDO
  705. nmw=idate(2)
  706. ! field name (has month: ozone1, ozone2, ..., ozone12)
  707. IF (nmw.LT.10) THEN
  708. WRITE(filemon,'(a,i1)')'ozone', nmw
  709. ELSE
  710. WRITE(filemon,'(a,i2)')'ozone', nmw
  711. ENDIF
  712. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  713. IF_NOTOK_RETURN(status=1)
  714. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  715. IF_NOTOK_RETURN(status=1)
  716. DO k=1,inp_levs
  717. field3d(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  718. ENDDO
  719. ! field name (has month: ozone1, ozone2, ..., ozone12)
  720. IF (nmw.LT.9) THEN
  721. nmw=idate(2)+1
  722. WRITE(filemon,'(a,i1)')'ozone',nmw
  723. ELSE
  724. nmw=idate(2)+1
  725. WRITE(filemon,'(a,i2)')'ozone',nmw
  726. ENDIF
  727. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  728. IF_NOTOK_RETURN(status=1)
  729. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  730. IF_NOTOK_RETURN(status=1)
  731. CALL MDF_Close( hid, status )
  732. IF_NOTOK_RETURN(status=1)
  733. DO k=1,inp_levs
  734. field3d_nm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  735. ENDDO
  736. src_lev = leviX_msr
  737. rgtype = 'mass-aver'
  738. deallocate( field3d_h )
  739. nmw=idate(2)
  740. endif
  741. !
  742. ! December
  743. !
  744. if(nmw .eq. 12) then
  745. nmw=idate(2)-1
  746. WRITE(filemon,'(a,i2)')'ozone',nmw
  747. CALL MDF_Open( TRIM(o3vmr_fname), MDF_HDF4, MDF_READ, hid, status )
  748. IF_NOTOK_RETURN(status=1)
  749. CALL MDF_Inq_VarID( hid,TRIM(filemon), varid, status )
  750. IF_NOTOK_RETURN(status=1)
  751. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  752. IF_NOTOK_RETURN(status=1)
  753. ! Flip the data over (upside down), since leviX_msr, associated with
  754. ! field3d when regridding below (Fill3D), is flipped w/r/t to levi
  755. ! [it is the case, since ecstring starts with "ec" and not "tm"
  756. ! --see grid_type_hyb.F90--]
  757. DO k=1,inp_levs
  758. field3d_pm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  759. ENDDO
  760. nmw=12
  761. WRITE(filemon,'(a,i2)')'ozone',nmw
  762. CALL MDF_Inq_VarID( hid,TRIM(filemon) , varid, status )
  763. IF_NOTOK_RETURN(status=1)
  764. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  765. IF_NOTOK_RETURN(status=1)
  766. CALL MDF_Close( hid, status )
  767. IF_NOTOK_RETURN(status=1)
  768. DO k=1,inp_levs
  769. field3d(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  770. ENDDO
  771. nmw=1
  772. WRITE(filemon,'(a,i1)')'ozone',nmw
  773. CALL MDF_Open( TRIM(o3vmr_fnamenm), MDF_HDF4, MDF_READ, hid, status )
  774. IF_NOTOK_RETURN(status=1)
  775. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  776. IF_NOTOK_RETURN(status=1)
  777. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  778. IF_NOTOK_RETURN(status=1)
  779. CALL MDF_Close( hid, status )
  780. IF_NOTOK_RETURN(status=1)
  781. DO k=1,inp_levs
  782. field3d_nm(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  783. ENDDO
  784. src_lev = leviX_msr
  785. rgtype = 'mass-aver'
  786. deallocate( field3d_h )
  787. endif
  788. ELSE ! use other file already remapped to model levels (e.g. o3vmr2000_tropo25.hdf)
  789. allocate( field3d(1, nlat180, lm(1) ))
  790. field3d=0.0
  791. o3vmr_fname=o3vmr_dirname
  792. CALL MDF_Open( TRIM(o3vmr_fname), MDF_HDF4, MDF_READ, hid, status )
  793. IF_NOTOK_RETURN(status=1)
  794. CALL MDF_Get_Var( hid, idate(2), field3d(1,:,:), status )
  795. IF_NOTOK_RETURN(status=1)
  796. CALL MDF_Close( hid, status )
  797. IF_NOTOK_RETURN(status=1)
  798. src_lev = levi
  799. rgtype = 'area-aver'
  800. ENDIF
  801. ! Coarsen/distribute to each 1 resolution
  802. ALLOCATE( sp_z(1,jm(1)) ) ! dummy surface pressure:
  803. sp_z = p0 ! 1e5 Pa
  804. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3dpm_ML, &
  805. lli_z(iglbsfc), src_lev, field3d_pm, rgtype, status )
  806. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3d_ML, &
  807. lli_z(iglbsfc), src_lev, field3d, rgtype, status )
  808. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3dnm_ML, &
  809. lli_z(iglbsfc), src_lev, field3d_nm, rgtype, status )
  810. ENDIF
  811. IF_NOTOK_RETURN(status=1)
  812. deallocate( sp_z )
  813. deallocate( field3d_pm)
  814. deallocate( field3d )
  815. deallocate( field3d_nm)
  816. END IF ROOT
  817. ! scatter along latitude direction, then broadcast
  818. wrk2d_ML = wrk3dpm_ML(1,:,:) ! reshape
  819. CALL SCATTER_I_BAND( dgrid(1), o3vmrpm(1)%d23, wrk2d_ML, status )
  820. IF_NOTOK_RETURN(status=1)
  821. CALL PAR_BROADCAST( o3vmrpm(1)%d23, status, row=.TRUE. )
  822. IF_NOTOK_RETURN(status=1)
  823. wrk2d_ML = wrk3d_ML(1,:,:) ! reshape
  824. CALL SCATTER_I_BAND( dgrid(1), o3vmr(1)%d23, wrk2d_ML, status )
  825. IF_NOTOK_RETURN(status=1)
  826. CALL PAR_BROADCAST( o3vmr(1)%d23, status, row=.TRUE. )
  827. IF_NOTOK_RETURN(status=1)
  828. wrk2d_ML = wrk3dnm_ML(1,:,:) ! reshape
  829. CALL SCATTER_I_BAND( dgrid(1), o3vmrnm(1)%d23, wrk2d_ML, status )
  830. IF_NOTOK_RETURN(status=1)
  831. CALL PAR_BROADCAST( o3vmrnm(1)%d23, status, row=.TRUE. )
  832. IF_NOTOK_RETURN(status=1)
  833. !--------------------------------------------------
  834. ! ** O3 DU
  835. !--------------------------------------------------
  836. IF (use_o3du) THEN
  837. IF(isRoot) THEN
  838. ! o3du only required for 40 or 62 levels
  839. inp_levs = lme
  840. ALLOCATE( field3d (1, nlat180, inp_levs) )
  841. ALLOCATE( field3d_h(1, nlat180, inp_levs) )
  842. nmw=idate(2) ! pick out right month in file
  843. WRITE(o3du_fname,'(a,"msr2_o3du",i4,"_",i2,".hdf")')TRIM(o3du_dirname),idate(1),inp_levs
  844. IF (nmw.LT.10) THEN
  845. WRITE(filemon,'(a,i1)')'ozone', idate(2)
  846. ELSE
  847. WRITE(filemon,'(a,i2)')'ozone', idate(2)
  848. ENDIF
  849. CALL MDF_Open( TRIM(o3du_fname), MDF_HDF4, MDF_READ, hid, status )
  850. IF_NOTOK_RETURN(status=1)
  851. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  852. IF_NOTOK_RETURN(status=1)
  853. CALL MDF_Get_Var( hid, varid, field3d_h, status )
  854. IF_NOTOK_RETURN(status=1)
  855. CALL MDF_Close( hid, status )
  856. IF_NOTOK_RETURN(status=1)
  857. ! flip data so that they are on the leviX levels
  858. DO k=1,inp_levs
  859. field3d(1,:,k)=field3d_h(1,:,inp_levs+1-k)
  860. ENDDO
  861. ! remap to model levels
  862. ALLOCATE( sp_z(1,jm(1)) )
  863. sp_z = p0 ! 1e5 Pa
  864. ! Should we really use leviX_msr here?
  865. ! Doesn't seem to match with the use of lme above.
  866. ! Anyway, o3du is normally not used anymore,
  867. ! since the vertical resolution has increased.
  868. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3d_ML, &
  869. lli_z(iglbsfc), leviX_msr, field3d, 'area-aver', status )
  870. IF_NOTOK_RETURN(status=1)
  871. DEALLOCATE( sp_z )
  872. DEALLOCATE( field3d )
  873. DEALLOCATE( field3d_h )
  874. END IF
  875. ! scatter along latitude direction, then broadcast
  876. wrk2d_ML = wrk3d_ML(1,:,:)
  877. CALL SCATTER_I_BAND( dgrid(1), o3du(1)%d23, wrk2d_ML, status )
  878. IF_NOTOK_RETURN(status=1)
  879. CALL PAR_BROADCAST( o3du(1)%d23, status, row=.TRUE. )
  880. IF_NOTOK_RETURN(status=1)
  881. ENDIF ! use_o3du
  882. !--------------------------------------------------
  883. ! ** CH4 HALOE
  884. !--------------------------------------------------
  885. IF (use_HALOE) THEN
  886. IF(isRoot) THEN
  887. inp_levs = LeviX_haloe%nlev
  888. if (LCMIP6_CH4) then
  889. allocate(ch4_hist(1,2015)) ! years 0-2014
  890. ! WRITE(ch4_hist_fname,'(a,"mole_fraction_of_methane_in_air_input4MIPs_GHGConcentrations_CMIP_UoM-CMIP-1-2-0_gr1-GMNHSH_0000-2014.nc")')TRIM(cmip6_ch4_dirname_strat)
  891. WRITE(ch4_hist_fname,'(a,"CMIP6_histo_mole_fraction_of_methane_in_air_input4MIPs_gr1-GMNHSH.nc")')TRIM(cmip6_ch4_dirname_strat)
  892. CALL MDF_Open( TRIM(ch4_hist_fname), MDF_NETCDF, MDF_READ, hid, status )
  893. IF_NOTOK_RETURN(status=1)
  894. CALL MDF_Inq_VarID( hid, TRIM('mole_fraction_of_methane_in_air'), varid, status )
  895. IF_NOTOK_RETURN(status=1)
  896. CALL MDF_Get_Var( hid, varid, ch4_hist(1,:), status, start = (/1,1/), count = (/1,2015/) )
  897. IF_NOTOK_RETURN(status=1)
  898. CALL MDF_Close( hid, status )
  899. IF_NOTOK_RETURN(status=1)
  900. ! Following the recommendation by Meinshausen et al. (GMDD, 2016),
  901. ! a one year delay is assumed between the surface and the stratosphere.
  902. ! The HALOE climatology is based on measurements
  903. ! from October 1991 to August 2002.
  904. ! HALOE therefore provides the full annual cycle
  905. ! for the 10-year period 1992-2001.
  906. ! Since our scaling is based on annual mean concentrations,
  907. ! we take this period as our reference.
  908. ! To account for the delay of one year,
  909. ! this translates into 1991-2000 at the surface.
  910. ch4_ref=0.
  911. do iyear=1991,2000
  912. ! First year of ch4_hist is the year 0
  913. ch4_ref=ch4_ref+ch4_hist(1,iyear+1)
  914. enddo
  915. ch4_ref=ch4_ref/10.
  916. if ( ( (.not.ch4_fixyear) .and. &
  917. ( (idate(1) .gt. 2015) .or. (idate(1)==2015 .and. idate(2)==12) ) ) &
  918. .or. &
  919. (ch4_fixyear .and. ch4_year.gt.2014) ) then
  920. write (gol,'("ERROR - Scaling of stratospheric CH4 concentrations from HALOE")') ; call goPr
  921. write (gol,'("ERROR - not implemented yet for CMIP6 scenarios")') ; call goErr
  922. status=1; TRACEBACK; return
  923. allocate(ch4_sce(1,86)) ! years 2015-2100
  924. ! include case statement to use different filename for each scenario
  925. WRITE(ch4_sce_fname,'(a,"xxxx")')TRIM(cmip6_ch4_dirname_strat)
  926. CALL MDF_Open( TRIM(ch4_sce_fname), MDF_NETCDF, MDF_READ, hid, status )
  927. IF_NOTOK_RETURN(status=1)
  928. CALL MDF_Inq_VarID( hid, TRIM('mole_fraction_of_methane_in_air'), varid, status )
  929. IF_NOTOK_RETURN(status=1)
  930. CALL MDF_Get_Var( hid, varid, ch4_sce(1,:), status, start = (/1,1/), count = (/1,86/) )
  931. IF_NOTOK_RETURN(status=1)
  932. CALL MDF_Close( hid, status )
  933. IF_NOTOK_RETURN(status=1)
  934. endif
  935. ! Following CMIP methodology,
  936. ! surface concentrations before 1850
  937. ! are set to their 1850 level.
  938. !
  939. ! target_year is the year used in the scaling
  940. ! of surface concentrations.
  941. ! scale factor for previous month:
  942. if (.not.ch4_fixyear) then
  943. target_year = MIN(2100,MAX(idate(1)-1,1850))
  944. if(idate(2) .eq. 1) then
  945. target_year = MIN(2100,MAX(idate(1)-2,1850))
  946. endif
  947. else
  948. target_year = MIN(2100,MAX(ch4_year,1850))
  949. endif
  950. write (gol,*) 'Stratospheric CH4 year for previous month: ', target_year; call goPr
  951. if (target_year .le. 2014) then
  952. ch4_scale_pm=ch4_hist(1,target_year+1)/ch4_ref
  953. else
  954. ch4_scale_pm=ch4_sce(1,target_year-2014)/ch4_ref
  955. endif
  956. ! scale factor for the current month:
  957. if (.not.ch4_fixyear) then
  958. target_year = MIN(2100,MAX(idate(1)-1,1850))
  959. else
  960. target_year = MIN(2100,MAX(ch4_year,1850))
  961. endif
  962. write (gol,*) 'Stratospheric CH4 year for current month: ', target_year; call goPr
  963. if (target_year .le. 2014) then
  964. ch4_scale=ch4_hist(1,target_year+1)/ch4_ref
  965. else
  966. ch4_scale=ch4_sce(1,target_year-2014)/ch4_ref
  967. endif
  968. ! scale factor for the next month:
  969. if (.not.ch4_fixyear) then
  970. target_year = MIN(2100,MAX(idate(1)-1,1850))
  971. if(idate(2) .eq. 12) then
  972. target_year = MIN(2100,MAX(idate(1),1850))
  973. endif
  974. else
  975. target_year = MIN(2100,MAX(ch4_year,1850))
  976. endif
  977. write (gol,*) 'Stratospheric CH4 year for next month: ', target_year; call goPr
  978. if (target_year .le. 2014) then
  979. ch4_scale_nm=ch4_hist(1,target_year+1)/ch4_ref
  980. else
  981. ch4_scale_nm=ch4_sce(1,target_year-2014)/ch4_ref
  982. endif
  983. deallocate(ch4_hist)
  984. if (allocated(ch4_sce)) deallocate(ch4_sce)
  985. else
  986. ! The pre-CMIP6 calculation of the scale factors is not fully
  987. ! consistent with the new implementation for CMIP6.
  988. ! This could be changed, but I haven't done that.
  989. ! I would propose to use LCMIP6_CH4 by default,
  990. ! and remove the scaling based on RCP6 from the code.
  991. write (gol,'("WARNING - Scaling of stratospheric CH4 concentrations from HALOE")') ; call goPr
  992. write (gol,'("WARNING - based on old implementation, which uses RCP6 for years later than 2005.")') ; call goPr
  993. if (ch4_fixyear) then
  994. write (gol,'("ERROR - Fixing CH4 concentrations to a specific year")') ; call goErr
  995. write (gol,'("ERROR - only works for CMIP6 data")') ; call goErr
  996. status=1; TRACEBACK; return
  997. endif
  998. ! The scale factor for the previous month
  999. ! used to be based on the previous year
  1000. ! irrespective of the month.
  1001. ! This is incorrect and has been fixed:
  1002. !valid_year = MIN(2035,MAX(idate(1)-1,1999))
  1003. valid_year = MIN(2035,MAX(idate(1),1999))
  1004. if(idate(2) .eq. 1) then
  1005. valid_year = MIN(2035,MAX(idate(1)-1,1999))
  1006. endif
  1007. ch4_scale_pm=RCP6_CH4_STRAT(valid_year-1998)
  1008. ! scale factor for the current month
  1009. valid_year = MIN(2035,MAX(idate(1),1999))
  1010. ch4_scale=RCP6_CH4_STRAT(valid_year-1998)
  1011. ! scale factor for the next month
  1012. valid_year = MIN(2035,MAX(idate(1),1999))
  1013. if(idate(2) .eq. 12) then
  1014. valid_year = MIN(2035,MAX(idate(1)+1,1999))
  1015. endif
  1016. ch4_scale_nm=RCP6_CH4_STRAT(valid_year-1998)
  1017. endif
  1018. allocate( field3d_pm (1, nlat180, inp_levs) )
  1019. allocate( field3d (1, nlat180, inp_levs) )
  1020. allocate( field3d_nm (1, nlat180, inp_levs) )
  1021. allocate( field3d_h (1, nlat180, inp_levs) )
  1022. field3d_pm=0.0 ; field3d=0.0 ; field3d_nm=0.0 ; field3d_h=0.0
  1023. !
  1024. ! For each month, data are read, then flipped over (upside down), otherwise Fill3D
  1025. ! doesn't work properly, and scaled up to account for growth from 2000.
  1026. !
  1027. ! - Previous month
  1028. !
  1029. if(idate(2) .eq. 1) then
  1030. nmw=12
  1031. WRITE(filemon,'(a,i2)')'haloe',nmw
  1032. else
  1033. nmw=idate(2)-1
  1034. if(idate(2) .lt. 11) WRITE(filemon,'(a,i1)')'haloe',nmw
  1035. if(idate(2) .gt. 10) WRITE(filemon,'(a,i2)')'haloe',nmw
  1036. endif
  1037. !
  1038. WRITE(ch4vmr_fname,'(a,"haloe_ch4vmr_",i2,".hdf")')TRIM(ch4vmr_dirname),inp_levs
  1039. CALL MDF_Open( TRIM(ch4vmr_fname), MDF_HDF4, MDF_READ, hid, status )
  1040. IF_NOTOK_RETURN(status=1)
  1041. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  1042. IF_NOTOK_RETURN(status=1)
  1043. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  1044. IF_NOTOK_RETURN(status=1)
  1045. DO k=1,inp_levs
  1046. field3d_pm(1,:,k)=field3d_h(1,:,inp_levs+1-k)*ch4_scale_pm
  1047. ENDDO
  1048. !
  1049. ! - Current month
  1050. !
  1051. nmw=idate(2)
  1052. IF (nmw.LT.10) THEN
  1053. WRITE(filemon,'(a,i1)')'haloe', nmw
  1054. ELSE
  1055. WRITE(filemon,'(a,i2)')'haloe', nmw
  1056. ENDIF
  1057. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  1058. IF_NOTOK_RETURN(status=1)
  1059. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  1060. IF_NOTOK_RETURN(status=1)
  1061. DO k=1,inp_levs
  1062. field3d(1,:,k)=field3d_h(1,:,inp_levs+1-k)*ch4_scale
  1063. ENDDO
  1064. !
  1065. ! - Next month
  1066. !
  1067. nmw=idate(2)+1
  1068. if(idate(2) .eq. 12) then
  1069. nmw=1
  1070. endif
  1071. if(nmw .lt. 10) WRITE(filemon,'(a,i1)')'haloe', nmw
  1072. if(nmw .gt. 9) WRITE(filemon,'(a,i2)')'haloe', nmw
  1073. CALL MDF_Inq_VarID( hid, TRIM(filemon), varid, status )
  1074. IF_NOTOK_RETURN(status=1)
  1075. CALL MDF_Get_Var( hid, varid, field3d_h(1,:,:), status )
  1076. IF_NOTOK_RETURN(status=1)
  1077. CALL MDF_Close( hid, status )
  1078. IF_NOTOK_RETURN(status=1)
  1079. DO k=1,inp_levs
  1080. field3d_nm(1,:,k)=field3d_h(1,:,inp_levs+1-k)*ch4_scale_nm
  1081. ENDDO
  1082. !
  1083. ! Coarsen or distribute on region #1 the three datasets
  1084. !
  1085. ALLOCATE( sp_z(1,jm(1)) )
  1086. sp_z = p0 ! 1e5 Pa
  1087. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3dpm_ML, &
  1088. lli_z(iglbsfc), leviX_haloe, field3d_pm, 'mass-aver', status )
  1089. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3d_ML, &
  1090. lli_z(iglbsfc), leviX_haloe, field3d, 'mass-aver', status )
  1091. CALL Fill3D( lli_z(1), levi, 'n', sp_z, wrk3dnm_ML, &
  1092. lli_z(iglbsfc), leviX_haloe, field3d_nm, 'mass-aver', status )
  1093. IF_NOTOK_RETURN(status=1)
  1094. ! clear allocatables
  1095. deallocate( sp_z )
  1096. deallocate( field3d_pm )
  1097. deallocate( field3d )
  1098. deallocate( field3d_nm )
  1099. deallocate( field3d_h )
  1100. END IF ! Read & Regrid on Root
  1101. ! Scatter along latitude direction, then broadcast to other cores in same zonal band
  1102. wrk2d_ML = wrk3dpm_ML(1,:,:)
  1103. CALL SCATTER_I_BAND( dgrid(1), ch4vmrpm(1)%d23, wrk2d_ML, status )
  1104. IF_NOTOK_RETURN(status=1)
  1105. CALL PAR_BROADCAST( ch4vmrpm(1)%d23, status, row=.TRUE. )
  1106. IF_NOTOK_RETURN(status=1)
  1107. wrk2d_ML = wrk3d_ML(1,:,:)
  1108. CALL SCATTER_I_BAND( dgrid(1), ch4vmr(1)%d23, wrk2d_ML, status )
  1109. IF_NOTOK_RETURN(status=1)
  1110. CALL PAR_BROADCAST( ch4vmr(1)%d23, status, row=.TRUE. )
  1111. IF_NOTOK_RETURN(status=1)
  1112. wrk2d_ML = wrk3dnm_ML(1,:,:)
  1113. CALL SCATTER_I_BAND( dgrid(1), ch4vmrnm(1)%d23, wrk2d_ML, status )
  1114. IF_NOTOK_RETURN(status=1)
  1115. CALL PAR_BROADCAST( ch4vmrnm(1)%d23, status, row=.TRUE. )
  1116. IF_NOTOK_RETURN(status=1)
  1117. ENDIF ! use_HALO
  1118. !--------------------------------------------------
  1119. ! ** ODIN climatology : HNO3/O3 and CO/O3 ratios
  1120. !--------------------------------------------------
  1121. IF (use_ODIN) then
  1122. inp_levs=4
  1123. !--------------------------------------------------
  1124. ! * ODIN climatology : HNO3/O3
  1125. !--------------------------------------------------
  1126. IF ( isRoot ) THEN
  1127. ! open, read ratio
  1128. CALL MDF_Open( TRIM(covmr_dirname)//'/ODIN_Climatology_HNO3_O3_4levels.hdf', MDF_HDF4, MDF_READ, hid, status )
  1129. IF_NOTOK_RETURN(status=1)
  1130. CALL MDF_Inq_VarID( hid, 'Ratio', varid, status )
  1131. IF_NOTOK_RETURN(status=1)
  1132. CALL MDF_Get_Var( hid,varid, field3d_r4, status )
  1133. IF_NOTOK_RETURN(status=1)
  1134. pm=idate(2)-1
  1135. ! previous month
  1136. allocate( field3d(1,nlat180,4) )
  1137. if(idate(2) .eq. 1) field3d(1,:,:)=field3d_r4(:,:,12)
  1138. if(idate(2) .gt. 1) field3d(1,:,:)=field3d_r4(:,:,pm)
  1139. ! remap
  1140. DO i=1,inp_levs
  1141. CALL FillGrid( lli_z(1), 'n', wrk3dratiopm(:,:,i), &
  1142. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1143. IF_NOTOK_RETURN(status=1)
  1144. END DO
  1145. ! current month
  1146. field3d(1,:,:)=field3d_r4(:,:,idate(2))
  1147. ! remap
  1148. DO i=1,inp_levs
  1149. CALL FillGrid( lli_z(1), 'n', wrk3dratio(:,:,i), &
  1150. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1151. IF_NOTOK_RETURN(status=1)
  1152. END DO
  1153. nm=idate(2)+1
  1154. if(idate(2) .lt. 12) field3d(1,:,:)=field3d_r4(:,:,nm)
  1155. if(idate(2) .eq. 12) field3d(1,:,:)=field3d_r4(:,:,1)
  1156. ! remap
  1157. DO i=1,inp_levs
  1158. CALL FillGrid( lli_z(1), 'n', wrk3drationm(:,:,i), &
  1159. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1160. IF_NOTOK_RETURN(status=1)
  1161. END DO
  1162. CALL MDF_Close( hid, status )
  1163. IF_NOTOK_RETURN(status=1)
  1164. DEALLOCATE( field3d )
  1165. END IF ! root
  1166. ! Scatter along latitude direction, then broadcast to other cores in same zonal band
  1167. wrk2d_4L = wrk3dratiopm(1,:,:)
  1168. CALL SCATTER_I_BAND( dgrid(1), odin_hno3_o3_pm(1)%d23(:,:), wrk2d_4L, status )
  1169. IF_NOTOK_RETURN(status=1)
  1170. CALL PAR_BROADCAST( odin_hno3_o3_pm(1)%d23, status, row=.TRUE. )
  1171. IF_NOTOK_RETURN(status=1)
  1172. wrk2d_4L = wrk3dratio(1,:,:)
  1173. CALL SCATTER_I_BAND( dgrid(1), odin_hno3_o3(1)%d23(:,:), wrk2d_4L, status )
  1174. IF_NOTOK_RETURN(status=1)
  1175. CALL PAR_BROADCAST( odin_hno3_o3(1)%d23, status, row=.TRUE. )
  1176. IF_NOTOK_RETURN(status=1)
  1177. wrk2d_4L = wrk3drationm(1,:,:)
  1178. CALL SCATTER_I_BAND( dgrid(1), odin_hno3_o3_nm(1)%d23(:,:), wrk2d_4L, status )
  1179. IF_NOTOK_RETURN(status=1)
  1180. CALL PAR_BROADCAST( odin_hno3_o3_nm(1)%d23, status, row=.TRUE. )
  1181. IF_NOTOK_RETURN(status=1)
  1182. !--------------------------------------------------
  1183. ! * ODIN climatology : CO O3
  1184. !--------------------------------------------------
  1185. IF ( isRoot ) THEN
  1186. ! open, read ratio
  1187. CALL MDF_Open(TRIM(covmr_dirname)//'ODIN_CO_O3_ratio_4levels.hdf', MDF_HDF4, MDF_READ, hid, status )
  1188. IF_NOTOK_RETURN(status=1)
  1189. CALL MDF_Inq_VarID( hid, 'CO_O3_ratio', varid, status )
  1190. IF_NOTOK_RETURN(status=1)
  1191. CALL MDF_Get_Var( hid, varid, field3d_r4, status )
  1192. IF_NOTOK_RETURN(status=1)
  1193. allocate( field3d(1,nlat180,4) ) ! 1D array along latitude
  1194. pm=idate(2)-1
  1195. ! previous month
  1196. if(idate(2) .eq. 1) field3d(1,:,:)=field3d_r4(:,:,12)
  1197. if(idate(2) .gt. 1) field3d(1,:,:)=field3d_r4(:,:,pm)
  1198. ! remap
  1199. DO i=1,inp_levs
  1200. CALL FillGrid( lli_z(1), 'n', wrk3dratiopm(:,:,i), &
  1201. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1202. IF_NOTOK_RETURN(status=1)
  1203. END DO
  1204. ! current month
  1205. field3d(1,:,:)=field3d_r4(:,:,idate(2))
  1206. ! remap
  1207. DO i=1,inp_levs
  1208. CALL FillGrid( lli_z(1), 'n', wrk3dratio(:,:,i), &
  1209. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1210. IF_NOTOK_RETURN(status=1)
  1211. END DO
  1212. nm=idate(2)+1
  1213. ! correct month
  1214. if(idate(2) .lt. 12) field3d(1,:,:)=field3d_r4(:,:,nm)
  1215. if(idate(2) .eq. 12) field3d(1,:,:)=field3d_r4(:,:,1)
  1216. ! remap
  1217. DO i=1,inp_levs
  1218. CALL FillGrid( lli_z(1), 'n', wrk3drationm(:,:,i), &
  1219. lli_z(iglbsfc), 'n', field3d(:,:,i), 'area-aver', status )
  1220. IF_NOTOK_RETURN(status=1)
  1221. END DO
  1222. CALL MDF_Close( hid, status )
  1223. IF_NOTOK_RETURN(status=1)
  1224. deallocate( field3d )
  1225. END IF ! root
  1226. ! scatter along latitude direction, then broadcast
  1227. wrk2d_4L = wrk3dratiopm(1,:,:)
  1228. CALL SCATTER_I_BAND( dgrid(1), odin_co_o3_pm(1)%d23(:,:), wrk2d_4L, status )
  1229. IF_NOTOK_RETURN(status=1)
  1230. CALL PAR_BROADCAST( odin_co_o3_pm(1)%d23, status, row=.TRUE. )
  1231. IF_NOTOK_RETURN(status=1)
  1232. wrk2d_4L = wrk3dratio(1,:,:)
  1233. CALL SCATTER_I_BAND( dgrid(1), odin_co_o3(1)%d23(:,:), wrk2d_4L, status )
  1234. IF_NOTOK_RETURN(status=1)
  1235. CALL PAR_BROADCAST( odin_co_o3(1)%d23, status, row=.TRUE. )
  1236. IF_NOTOK_RETURN(status=1)
  1237. ! scatter along latitude direction, then broadcast
  1238. wrk2d_4L = wrk3drationm(1,:,:)
  1239. CALL SCATTER_I_BAND( dgrid(1), odin_co_o3_nm(1)%d23(:,:), wrk2d_4L, status )
  1240. IF_NOTOK_RETURN(status=1)
  1241. CALL PAR_BROADCAST( odin_co_o3_nm(1)%d23, status, row=.TRUE. )
  1242. IF_NOTOK_RETURN(status=1)
  1243. ELSE
  1244. !--------------------------------------------------
  1245. ! ** UARS climatology : HNO3 O3 (Fallback on this one if we are not using ODIN)
  1246. !--------------------------------------------------
  1247. IF ( isRoot ) THEN
  1248. ALLOCATE( field3d(1,nlat180,1) ) ! 1D array along latitude
  1249. field3d = 0.0
  1250. CALL MDF_Open( TRIM(inputdir)//'/boundary/HNO3_top/uars_ratio.hdf', MDF_HDF4, MDF_READ, hid, status )
  1251. IF_NOTOK_RETURN(status=1)
  1252. CALL MDF_Get_Var( hid, idate(2), field3d(:,:,1), status )
  1253. IF_NOTOK_RETURN(status=1)
  1254. CALL MDF_Close( hid, status )
  1255. IF_NOTOK_RETURN(status=1)
  1256. ! remap
  1257. CALL FillGrid( lli_z(1), 'n', wrk3dratio(:,:,1), &
  1258. lli_z(iglbsfc), 'n', field3d(:,:,1), 'area-aver', status )
  1259. IF_NOTOK_RETURN(status=1)
  1260. DEALLOCATE( field3d )
  1261. END IF ! root
  1262. ! scatter along latitude direction, then broadcast
  1263. wrk2d_ML(:,1) = wrk3dratio(1,:,1)
  1264. CALL SCATTER_I_BAND( dgrid(1), odin_hno3_o3(1)%d23(:,1), wrk2d_ML(:,1), status )
  1265. IF_NOTOK_RETURN(status=1)
  1266. CALL PAR_BROADCAST( odin_hno3_o3(1)%d23(:,1), status, row=.TRUE. )
  1267. IF_NOTOK_RETURN(status=1)
  1268. ENDIF
  1269. ! ------------------------------------------------
  1270. ! Annual mean CO2 mixing ratios for pH calculation
  1271. ! used in aqueous chemistry.
  1272. !-------------------------------------------------
  1273. ! To avoid MPI communication,
  1274. ! reading is done on all processors,
  1275. ! but only once per year.
  1276. !-------------------------------------------------
  1277. if (LCMIP6_CO2 .and. newyr) then
  1278. IF ( isRoot ) THEN
  1279. ! Following CMIP methodology,
  1280. ! CO2 mixing ratios before 1850
  1281. ! are set to their 1850 level.
  1282. !
  1283. if (.not.co2_fixyear) then
  1284. target_year = MIN(2100,MAX(idate(1),1850))
  1285. else
  1286. target_year = MIN(2100,MAX(co2_year,1850))
  1287. endif
  1288. write (gol,*) 'In pH calculation, using CO2 for year: ', target_year; call goPr
  1289. if (target_year .le. 2014) then
  1290. allocate(co2_hist(1,2015)) ! years 0-2014
  1291. ! WRITE(co2_hist_fname,'(a,"mole_fraction_of_carbon_dioxide_in_air_input4MIPs_GHGConcentrations_CMIP_UoM-CMIP-1-2-0_gr1-GMNHSH_0000-2014.nc")')TRIM(cmip6_co2_dirname)
  1292. WRITE(co2_hist_fname,'(a,"CMIP6_histo_mole_fraction_of_carbon_dioxide_in_air_input4MIPs_gr1-GMNHSH.nc")')TRIM(cmip6_co2_dirname)
  1293. CALL MDF_Open( TRIM(co2_hist_fname), MDF_NETCDF, MDF_READ, hid, status )
  1294. IF_NOTOK_RETURN(status=1)
  1295. CALL MDF_Inq_VarID( hid, TRIM('mole_fraction_of_carbon_dioxide_in_air'), varid, status )
  1296. IF_NOTOK_RETURN(status=1)
  1297. CALL MDF_Get_Var( hid, varid, co2_hist(1,:), status, start = (/1,1/), count = (/1,2015/) )
  1298. IF_NOTOK_RETURN(status=1)
  1299. CALL MDF_Close( hid, status )
  1300. IF_NOTOK_RETURN(status=1)
  1301. co2_glob=co2_hist(1,target_year+1)
  1302. deallocate(co2_hist)
  1303. else
  1304. write (gol,'("ERROR - Reading of CO2 mixing ratios")') ; call goPr
  1305. write (gol,'("ERROR - not implemented yet for CMIP6 scenarios")') ; call goErr
  1306. status=1; TRACEBACK; return
  1307. allocate(co2_sce(1,86)) ! years 2015-2100
  1308. ! include case statement to use different filename for each scenario
  1309. WRITE(co2_sce_fname,'(a,"xxxx")')TRIM(cmip6_co2_dirname)
  1310. CALL MDF_Open( TRIM(co2_sce_fname), MDF_NETCDF, MDF_READ, hid, status )
  1311. IF_NOTOK_RETURN(status=1)
  1312. CALL MDF_Inq_VarID( hid, TRIM('mole_fraction_of_carbon_dioxide_in_air'), varid, status )
  1313. IF_NOTOK_RETURN(status=1)
  1314. CALL MDF_Get_Var( hid, varid, co2_sce(1,:), status, start = (/1,1/), count = (/1,86/) )
  1315. IF_NOTOK_RETURN(status=1)
  1316. CALL MDF_Close( hid, status )
  1317. IF_NOTOK_RETURN(status=1)
  1318. co2_glob=co2_sce(1,target_year-2014)
  1319. deallocate(co2_sce)
  1320. endif
  1321. ENDIF ! root
  1322. CALL PAR_BROADCAST( co2_glob, status )
  1323. IF_NOTOK_RETURN(status=1)
  1324. write (gol,*) 'Annual mean CO2 mixing ratio (ppm) = ', co2_glob; call goPr
  1325. ENDIF
  1326. ! end timing:
  1327. call GO_Timer_End( itim_init, status )
  1328. IF_NOTOK_RETURN(status=1)
  1329. END IF
  1330. CALL goLabel()
  1331. status = 0
  1332. END SUBROUTINE BOUNDARY_INIT
  1333. !EOC
  1334. !--------------------------------------------------------------------------
  1335. ! TM5 !
  1336. !--------------------------------------------------------------------------
  1337. !BOP
  1338. !
  1339. ! !IROUTINE: BOUNDARY_DONE
  1340. !
  1341. ! !DESCRIPTION: deallocate arrays (budgets gathering/reduction is done in
  1342. ! chemistry/chemistry_done)
  1343. !\\
  1344. !\\
  1345. ! !INTERFACE:
  1346. !
  1347. SUBROUTINE BOUNDARY_DONE( status )
  1348. !
  1349. ! !USES:
  1350. !
  1351. USE partools, ONLY : isRoot
  1352. USE Grid, ONLY : Done
  1353. !
  1354. ! !OUTPUT PARAMETERS:
  1355. !
  1356. INTEGER, INTENT(out) :: status
  1357. !
  1358. ! !REVISION HISTORY:
  1359. ! 15 Jun 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  1360. !
  1361. !EOP
  1362. !------------------------------------------------------------------------
  1363. !BOC
  1364. CHARACTER(len=*), PARAMETER :: rname = mname//'/Boundary_Done'
  1365. ! --- begin ----------------------------------------
  1366. CALL goLabel(rname)
  1367. IF (isRoot) THEN
  1368. IF (LCMIP6_O3) THEN
  1369. CALL Done( LeviX_cmip6_o3, status )
  1370. IF_NOTOK_RETURN(status=1)
  1371. ENDIF
  1372. IF (use_MSR) THEN
  1373. CALL Done( LeviX_msr, status )
  1374. IF_NOTOK_RETURN(status=1)
  1375. ENDIF
  1376. IF (use_HALOE) THEN
  1377. CALL Done( LeviX_haloe, status )
  1378. IF_NOTOK_RETURN(status=1)
  1379. ENDIF
  1380. ENDIF
  1381. IF (LCMIP6_O3) THEN
  1382. if (allocated(weight_cmip62tm5)) deallocate (weight_cmip62tm5)
  1383. if (allocated(jlow_cmip62tm5)) deallocate (jlow_cmip62tm5)
  1384. ENDIF
  1385. IF (use_o3du) deallocate( o3du(1)%d23 )
  1386. deallocate( o3vmrpm (1)%d23 )
  1387. deallocate( o3vmr (1)%d23 )
  1388. deallocate( o3vmrnm (1)%d23 )
  1389. deallocate( ch4vmrpm (1)%d23 )
  1390. deallocate( ch4vmr (1)%d23 )
  1391. deallocate( ch4vmrnm (1)%d23 )
  1392. deallocate( o3ratpm (1)%d23 )
  1393. deallocate( o3rat (1)%d23 )
  1394. deallocate( o3ratnm (1)%d23 )
  1395. deallocate( ch4ratpm (1)%d23 )
  1396. deallocate( ch4rat (1)%d23 )
  1397. deallocate( ch4ratnm (1)%d23 )
  1398. deallocate( odin_hno3_o3 (1)%d23 )
  1399. deallocate( odin_hno3_o3_pm(1)%d23 )
  1400. deallocate( odin_hno3_o3_nm(1)%d23 )
  1401. deallocate( odin_co_o3 (1)%d23 )
  1402. deallocate( odin_co_o3_pm (1)%d23 )
  1403. deallocate( odin_co_o3_nm (1)%d23 )
  1404. deallocate( wrk3dpm_ML )
  1405. deallocate( wrk3d_ML )
  1406. deallocate( wrk3dnm_ML )
  1407. deallocate( wrk3dratio )
  1408. deallocate( wrk3dratiopm )
  1409. deallocate( wrk3drationm )
  1410. deallocate( wrk2d_ML )
  1411. deallocate( wrk2d_4L )
  1412. CALL goLabel()
  1413. status = 0
  1414. END SUBROUTINE BOUNDARY_DONE
  1415. !EOC
  1416. !--------------------------------------------------------------------------
  1417. ! TM5 !
  1418. !--------------------------------------------------------------------------
  1419. !BOP
  1420. !
  1421. ! !IROUTINE: BOUNDARY_APPLY
  1422. !
  1423. ! !DESCRIPTION:
  1424. !\\
  1425. !\\
  1426. ! !INTERFACE:
  1427. !
  1428. SUBROUTINE BOUNDARY_APPLY( region, status )
  1429. !
  1430. ! !USES:
  1431. !
  1432. USE dims, ONLY : im, jm, lm
  1433. USE dims, ONLY : ybeg
  1434. USE dims, ONLY : xref, yref, tref
  1435. USE dims, ONLY : at, bt
  1436. USE dims, ONLY : dx, dy
  1437. USE dims, ONLY : nsrce
  1438. USE dims, ONLY : okdebug
  1439. USE dims, ONLY : sec_day,sec_month
  1440. USE toolbox, ONLY : lvlpress
  1441. USE chem_param, ONLY : io3, io3s, ich4, ihno3, ico
  1442. USE chem_param, ONLY : xmair, xmhno3, xmo3, xmch4, xmco, fscale, ra
  1443. USE meteodata, ONLY : m_dat
  1444. USE global_data, ONLY : region_dat, mass_dat
  1445. USE partools, ONLY : par_reduce_element
  1446. use GO, ONLY : GO_Timer_End, GO_Timer_Start
  1447. !
  1448. ! !INPUT PARAMETERS:
  1449. !
  1450. INTEGER, INTENT(in) :: region
  1451. !
  1452. ! !OUTPUT PARAMETERS:
  1453. !
  1454. INTEGER, INTENT(out) :: status
  1455. !
  1456. ! !REVISION HISTORY:
  1457. ! 23 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  1458. !
  1459. !EOP
  1460. !------------------------------------------------------------------------
  1461. !BOC
  1462. CHARACTER(len=*), PARAMETER :: rname = mname//'/Boundary_Apply'
  1463. ! Nudging coefficients for O3 and CH4
  1464. REAL, PARAMETER :: gnud_pole = 2.894e-6 ! 1 / (4 days)
  1465. REAL, PARAMETER :: gnud_hilat = 3.858e-6 ! 1 / (3 days)
  1466. REAL, PARAMETER :: gnud_trop = 4.630e-6 ! 1 / (2.5 days)
  1467. ! Nudging coefficients for HNO3 and CO (tested by B. Maasakkers, see KNMI internship report)
  1468. REAL, PARAMETER :: gnud_hno3_5hpa = 2.315e-6 ! 1 / (5 days)
  1469. REAL, PARAMETER :: gnud_hno3_10hpa = 5.587e-7 ! 1 / (10 days)
  1470. REAL, PARAMETER :: gnud_hno3_28hpa = 1.987e-7 ! 1 / (60 days)
  1471. REAL, PARAMETER :: gnud_hno3_43hpa = 2.572e-7 ! 1 / (45 days)
  1472. REAL,DIMENSION(:,:,:), POINTER :: m, ppm
  1473. REAL,DIMENSION(:,:,:,:), POINTER :: rm
  1474. REAL,DIMENSION(:,:), ALLOCATABLE :: znl_lcl, zonal_glbl ! zonal (total or average), local and global
  1475. INTEGER :: lmr, nlevels, nudge_lev, daystep
  1476. INTEGER :: i, j, l, ipos, nzone, nzone_v, n, lm_min, nday
  1477. REAL :: pr, dtime, dyy, xlat, gnud, o3za, ch4za, coza
  1478. REAL :: rmold, rmold1, rmold2, z, z1, z2, rmobs, rmobs1, rmobs2
  1479. INTEGER :: lsave, i1, i2, j1, j2
  1480. REAL :: fraction_pm, fraction_cm, fraction_nm, daily_scale
  1481. REAL :: diffmin, pressure(4), gnud_hno3(4), gnud_co(4)
  1482. REAL :: nudgeFactor, tm5_o3_hno3_mix_ratio, tm5_o3_co_mix_ratio
  1483. !
  1484. ! no. days from 20th month till end
  1485. !
  1486. REAL, DIMENSION(12) :: nday_em = (/11.0, 8.0, 11.0, 10.0, 11.0, 10.0, 11.0, 11.0, 10.0, 11.0, 10.0, 11.0/)
  1487. ! --- Begin ----------------------------------
  1488. ! O3, O3S and CH4 are relaxed to climatology at stratospheric layers
  1489. ! HNO3 is prescribed at level lm using ODIN or UARS HNO3:03 ratios
  1490. ! CO is prescribed at level lm using ODIN CO:03 ratios
  1491. ! start timing:
  1492. call GO_Timer_Start( itim_appl, status )
  1493. IF_NOTOK_RETURN(status=1)
  1494. CALL goLabel(rname)
  1495. CALL Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  1496. lmr=lm(region)
  1497. dtime=nsrce/(2*tref(region))
  1498. dyy=dy/yref(region) !gridsize at current region
  1499. rm => mass_dat(region)%rm
  1500. m => m_dat (region)%data
  1501. nday=sec_month/sec_day
  1502. !
  1503. ! Define the fractions from the previous and next months
  1504. ! For the period 10-20th of each month fraction_cm=1.0
  1505. !
  1506. fraction_pm = 0.0 ; fraction_nm = 0.0 ; fraction_cm = 1.0
  1507. if(idate(3) .lt. 10) then
  1508. fraction_pm = 1.0-((idate(3)+nday_em(idate(2)))/((nday_em(idate(2))+10)))
  1509. fraction_cm = 1.0-fraction_pm
  1510. endif
  1511. if(idate(3) .gt. 20) then
  1512. fraction_nm = 0.5*(real(idate(3))-20.5)/(real(nday)-20.0)
  1513. fraction_cm = 1.0-fraction_nm
  1514. endif
  1515. ! ---------------------------------------------------------------------
  1516. ! Get the NUDGING FACTORS
  1517. ! ---------------------------------------------------------------------
  1518. ! Only for the global domain, for which we are sure a good Zonal Average
  1519. ! can be calculated. The nudging factors are given by the ratio between
  1520. ! the climatological zonal mean and the observed zonal mean.
  1521. IF (region==1) THEN
  1522. ! Calculate the ratio of the climatology and the zonal mean model field.
  1523. ! The concentration at a given longitude is relaxed towards the ratio of
  1524. ! climatology and zonal mean model field multiplied by the model value
  1525. ALLOCATE( zonal_glbl(j1:j2, lm(1)) )
  1526. ALLOCATE( znl_lcl (j1:j2, lm(1)) )
  1527. ALLOCATE( ppm(i1:i2, j1:j2, lm(1)) )
  1528. ! ------ O3
  1529. ppm = 1e6*fscale(io3)*rm(i1:i2,j1:j2,:,io3)/m(i1:i2,j1:j2,:) ! into ppmv
  1530. znl_lcl=sum(ppm,dim=1) ! total zonal O3 in ppmv (local: i.e. only tile is accounted for)
  1531. CALL PAR_REDUCE_ELEMENT(znl_lcl, 'SUM', zonal_glbl, status, all=.true., row=.true.)
  1532. IF_NOTOK_RETURN(status=1)
  1533. ! zonal average
  1534. zonal_glbl = zonal_glbl/im(1)
  1535. DO l=1,lm(1)
  1536. DO j=j1,j2
  1537. !ratio clim/obs
  1538. IF ( zonal_glbl(j,l) == 0.0 ) THEN
  1539. o3ratpm(1)%d23(j,l) = 0.0
  1540. o3rat (1)%d23(j,l) = 0.0
  1541. o3ratnm(1)%d23(j,l) = 0.0
  1542. ELSE
  1543. o3ratpm(1)%d23(j,l) = o3vmrpm(1)%d23(j,l)/zonal_glbl(j,l)
  1544. o3rat (1)%d23(j,l) = o3vmr(1) %d23(j,l)/zonal_glbl(j,l)
  1545. o3ratnm(1)%d23(j,l) = o3vmrnm(1)%d23(j,l)/zonal_glbl(j,l)
  1546. END IF
  1547. ENDDO
  1548. ENDDO
  1549. ! ------ CH4
  1550. IF (use_HALOE) THEN ! else CH4rat remains 0 everywhere
  1551. ppm=1e6*fscale(ich4)*rm(i1:i2,j1:j2,:,ich4)/m(i1:i2,j1:j2,:)
  1552. znl_lcl=sum(ppm,dim=1) ! total zonal (local: i.e. tile only)
  1553. CALL PAR_REDUCE_ELEMENT(znl_lcl, 'SUM', zonal_glbl, status, all=.true., row=.true.)
  1554. IF_NOTOK_RETURN(status=1)
  1555. ! zonal average
  1556. zonal_glbl=zonal_glbl/im(1)
  1557. DO l=1,lm(1)
  1558. DO j=j1, j2
  1559. ! climatology/model ratio
  1560. IF ( zonal_glbl(j,l) == 0.0 ) THEN
  1561. CH4ratpm(1)%d23(j,l) = 0.0
  1562. CH4rat (1)%d23(j,l) = 0.0
  1563. CH4ratnm(1)%d23(j,l) = 0.0
  1564. ELSE
  1565. CH4ratpm(1)%d23(j,l) = ch4vmrpm(1)%d23(j,l)/zonal_glbl(j,l)
  1566. CH4rat (1)%d23(j,l) = ch4vmr (1)%d23(j,l)/zonal_glbl(j,l)
  1567. CH4ratnm(1)%d23(j,l) = ch4vmrnm(1)%d23(j,l)/zonal_glbl(j,l)
  1568. END IF
  1569. ENDDO
  1570. ENDDO
  1571. END IF
  1572. DEALLOCATE( ppm, znl_lcl, zonal_glbl)
  1573. ENDIF
  1574. ! ---------------------------------------------------------------------
  1575. ! Apply to O3 and CH4
  1576. ! ---------------------------------------------------------------------
  1577. DO j=j1,j2
  1578. xlat = ybeg(region) + (j+0.5)*dyy
  1579. IF (ABS(xlat) <= 30.0) THEN
  1580. lm_min = LVLPRESS(region, 4500., 98400.)
  1581. gnud = gnud_trop
  1582. ELSEIF(ABS(xlat)<66.0 ) THEN
  1583. lm_min = LVLPRESS(region, 9500., 98400.)
  1584. gnud = gnud_hilat
  1585. ELSE
  1586. lm_min = LVLPRESS(region, 12000., 98400.)
  1587. gnud = gnud_pole
  1588. ENDIF
  1589. DO l=lm_min,lm(region)
  1590. DO i=i1,i2
  1591. !
  1592. ! CMK: strictly spoken, the procedure om multi PEs is somewhat different.
  1593. ! Now they are independently nudged towards the same ZA!
  1594. ! In the long run, this will be the same! (hopefully) (FIXME : vraag MK wat betekend dat)
  1595. !
  1596. #ifndef without_o3_nudging
  1597. if(idate(3) .lt. 10) &
  1598. daily_scale = ((o3ratpm(region)%d23(j,l)*fraction_pm) + (o3rat(region)%d23(j,l)*fraction_cm))
  1599. if(idate(3) .gt. 9 .and. idate(3) .lt. 21) &
  1600. daily_scale = o3rat(region)%d23(j,l)
  1601. if(idate(3) .gt. 20) &
  1602. daily_scale = ((o3ratnm(region)%d23(j,l)*fraction_nm) + (o3rat(region)%d23(j,l)*fraction_cm))
  1603. rmobs = rm(i,j,l,io3)*daily_scale ! correct za
  1604. rmold = rm(i,j,l,io3) ! uncorrected value
  1605. z = (rmold+dtime*gnud*rmobs)/(1.+dtime*gnud) ! new concentration
  1606. rm(i,j,l,io3) = z
  1607. rmobs1 = rm(i,j,l,io3s)*daily_scale ! correct za
  1608. rmold1 = rm(i,j,l,io3s) ! uncorrected value
  1609. z1 = (rmold1+dtime*gnud*rmobs1)/(1.+dtime*gnud) ! new concentration
  1610. rm(i,j,l,io3s) = z1
  1611. #endif
  1612. if(idate(3) .lt. 10) &
  1613. daily_scale=((ch4ratpm(region)%d23(j,l)*fraction_pm) + (ch4rat(region)%d23(j,l)*fraction_cm))
  1614. if(idate(3) .gt. 9 .and. idate(3) .lt. 21) &
  1615. daily_scale=ch4rat(region)%d23(j,l)
  1616. if(idate(3) .gt. 20) &
  1617. daily_scale=((ch4ratnm(region)%d23(j,l)*fraction_nm)+ (ch4rat(region)%d23(j,l)*fraction_cm))
  1618. rmobs2 = rm(i,j,l,ich4)*daily_scale ! correct za
  1619. rmold2 = rm(i,j,l,ich4) ! uncorrected value
  1620. z2 = (rmold2+dtime*gnud*rmobs2)/(1.+dtime*gnud) ! new concentration
  1621. rm(i,j,l,ich4) = z2
  1622. #ifdef with_budgets
  1623. ! stratospheric budget....
  1624. nzone=budg_dat(region)%nzong(i,j) !global budget
  1625. nzone_v=nzon_vg(l)
  1626. #ifndef without_o3_nudging
  1627. budstratg(nzone,nzone_v,io3) = budstratg(nzone,nzone_v,io3) + (z-rmold)/xmo3*1e3 ! mole
  1628. budstratg(nzone,nzone_v,io3s) = budstratg(nzone,nzone_v,io3s) + (z1-rmold1)/xmo3*1e3 ! mole
  1629. #endif
  1630. budstratg(nzone,nzone_v,ich4) = budstratg(nzone,nzone_v,ich4) + (z2-rmold2)/xmch4*1e3 ! mole
  1631. ! #ifndef without_o3_nudging
  1632. ! IF( io3 == 1 ) THEN
  1633. ! sum_stratosphere(region) = sum_stratosphere(region) + z-rmold
  1634. ! END IF
  1635. ! IF ( io3s == 1 ) THEN
  1636. ! sum_stratosphere(region) = sum_stratosphere(region) + z1-rmold1
  1637. ! END IF
  1638. ! #endif
  1639. ! IF ( ich4 == 1 ) THEN
  1640. ! sum_stratosphere(region) = sum_stratosphere(region) + z2-rmold2
  1641. ! END IF
  1642. #endif /* BUDGETS */
  1643. END DO!i
  1644. END DO !l
  1645. END DO !j
  1646. !-------------------------------------------
  1647. ! set constraints for HNO3
  1648. !-------------------------------------------
  1649. IF (use_ODIN) then
  1650. nlevels=3 ! limit nudging to 3 top levels
  1651. pressure=(/550.0, 1122.0, 2820.0, 4365.0/) ! hPa
  1652. gnud_hno3 = (/gnud_hno3_5hpa, gnud_hno3_10hpa, gnud_hno3_28hpa, 0./)
  1653. ELSE
  1654. nlevels=1
  1655. pressure=(/1000.0, 0., 0., 0./) ! hPa
  1656. gnud_hno3 = (/gnud_hno3_10hpa, 0., 0., 0./)
  1657. ENDIF
  1658. DO nudge_lev=1,nlevels
  1659. lsave = 0 ! locate level closest to pressure[nudge_lev] hPa
  1660. diffmin = 1e10
  1661. DO l=1,lm(region)
  1662. pr = 0.5*(at(l)+at(l+1)) + 0.5*(bt(l)+bt(l+1))*1e5 ! pressure centre box
  1663. IF(ABS(pr-pressure(nudge_lev)) < diffmin) THEN
  1664. diffmin = ABS(pr-pressure(nudge_lev))
  1665. lsave = l
  1666. ENDIF
  1667. ENDDO
  1668. IF (use_ODIN) then
  1669. DO j=j1,j2
  1670. !
  1671. ! Smooth ratio between months to avoid spurious jumps in record
  1672. ! "daily_scale" is the time-interpolated ODIN climatology of the [HNO3]/[O3] ratio of mixing ratios
  1673. !
  1674. if ( idate(3) .lt. 10 ) &
  1675. daily_scale = odin_hno3_o3_pm(region)%d23(j,nudge_lev) * fraction_pm + &
  1676. odin_hno3_o3 (region)%d23(j,nudge_lev) * fraction_cm
  1677. if ( idate(3) .gt. 9 .and. idate(3) .lt. 21 ) &
  1678. daily_scale = odin_hno3_o3(region)%d23(j,nudge_lev)
  1679. if ( idate(3) .gt. 20 ) &
  1680. daily_scale = odin_hno3_o3_nm(region)%d23(j,nudge_lev) * fraction_nm + &
  1681. odin_hno3_o3 (region)%d23(j,nudge_lev) * fraction_cm
  1682. DO i=i1,i2
  1683. ! Include ratio of fscale factors, which convert from mass to mixing ratio
  1684. tm5_o3_hno3_mix_ratio = ( rm(i,j,lsave,io3) * fscale(io3) ) / ( rm(i,j,lsave,ihno3) * fscale(ihno3) )
  1685. nudgeFactor = ( 1.0 + dtime*gnud_hno3(NUDGE_LEV)*daily_scale*tm5_o3_hno3_mix_ratio ) / &
  1686. ( 1.0 + dtime*gnud_hno3(NUDGE_LEV) )
  1687. rmold = rm(i,j,lsave,ihno3)
  1688. z = rmold * nudgeFactor
  1689. rm(i,j,lsave,ihno3) = z
  1690. #ifdef with_budgets
  1691. ! stratospheric budget....
  1692. nzone=budg_dat(region)%nzong(i,j) !global budget
  1693. nzone_v=nzon_vg(lsave)
  1694. budstratg(nzone,nzone_v,ihno3)=budstratg(nzone,nzone_v,ihno3)+(z-rmold)/xmhno3*1e3 !mole
  1695. ! IF(ihno3 ==1) sum_stratosphere(region) = sum_stratosphere(region) + z-rmold
  1696. #endif
  1697. ENDDO!i
  1698. ENDDO!j
  1699. ELSE
  1700. DO j=j1,j2
  1701. DO i=i1,i2
  1702. rmold = rm(i,j,lsave,ihno3)
  1703. rmobs = rm(i,j,lsave,io3) * odin_hno3_o3(region)%d23(j,nudge_lev)
  1704. z = (rmold+dtime*gnud_hno3(NUDGE_LEV)*rmobs) / (1.+dtime*gnud_hno3(NUDGE_LEV)) !new concentration
  1705. rm(i,j,lsave,ihno3) = z
  1706. #ifdef with_budgets
  1707. ! stratospheric budget....
  1708. nzone=budg_dat(region)%nzong(i,j) !global budget
  1709. nzone_v=nzon_vg(lsave)
  1710. budstratg(nzone,nzone_v,ihno3)=budstratg(nzone,nzone_v,ihno3)+(z-rmold)/xmhno3*1e3 !mole
  1711. ! IF(ihno3 ==1) sum_stratosphere(region) = sum_stratosphere(region) + z-rmold
  1712. #endif
  1713. ENDDO!i
  1714. ENDDO!j
  1715. ENDIF
  1716. ENDDO ! nudge levels
  1717. ! This is not used (i.e. the global budget is not printed nor saved) so
  1718. ! this is commented. NOTE also that this should be moved to
  1719. ! chemistry/chemistry_done if ever used [PLS, 23-maart-2012]
  1720. !#ifdef with_budgets
  1721. ! CALL PAR_REDUCE(sum_stratosphere(region), 'SUM', sum_stratosphere(region), status)
  1722. ! IF_NOTOK_RETURN(status=1)
  1723. !#endif
  1724. !-------------------------------------------
  1725. ! Set constraints for CO nudging
  1726. !-------------------------------------------
  1727. IF (USE_ODIN) THEN
  1728. nlevels=3 ! limit nudging to 3 top levels
  1729. pressure=(/550.0, 1122.0, 2820.0, 4365.0/) ! hPa
  1730. gnud_co = (/gnud_hno3_5hpa, gnud_hno3_10hpa, gnud_hno3_28hpa, gnud_hno3_28hpa/)
  1731. DO nudge_lev=1,nlevels
  1732. lsave = 0 ! locate level closest to pressure level that is nudged
  1733. diffmin = 1e10
  1734. DO l=1,lm(region)
  1735. pr = 0.5*(at(l)+at(l+1)) + 0.5*(bt(l)+bt(l+1))*1e5 ! pressure centre box
  1736. IF(ABS(pr-1000.0) < diffmin) THEN
  1737. diffmin = ABS(pr-pressure(nudge_lev))
  1738. lsave = l
  1739. ENDIF
  1740. ENDDO
  1741. DO j=j1,j2
  1742. !
  1743. ! Smooth ratio between months to avoid spurious jumps in record
  1744. ! "daily_scale" is the time-interpolated ODIN climatology of the [CO]/[O3] ratio of mixing ratios
  1745. !
  1746. if ( idate(3) .lt. 10 ) &
  1747. daily_scale = odin_co_o3_pm(region)%d23(j,nudge_lev) * fraction_pm + &
  1748. odin_co_o3 (region)%d23(j,nudge_lev) * fraction_cm
  1749. if ( idate(3) .gt. 9 .and. idate(3) .lt. 21 ) &
  1750. daily_scale = odin_co_o3(region)%d23(j,nudge_lev)
  1751. if ( idate(3) .gt. 20 ) &
  1752. daily_scale = odin_co_o3_nm(region)%d23(j,nudge_lev) * fraction_nm + &
  1753. odin_co_o3 (region)%d23(j,nudge_lev) * fraction_cm
  1754. DO i=i1,i2
  1755. ! Include ratio of fscale factors, which convert from mass to mixing ratio
  1756. tm5_o3_co_mix_ratio = ( rm(i,j,lsave,io3) * fscale(io3) ) / ( rm(i,j,lsave,ico) * fscale(ico) )
  1757. nudgeFactor = ( 1.0 + dtime*gnud_co(NUDGE_LEV)*daily_scale*tm5_o3_co_mix_ratio ) / &
  1758. ( 1.0 + dtime*gnud_co(NUDGE_LEV) )
  1759. rmold = rm(i,j,lsave,ico)
  1760. z = rmold * nudgeFactor
  1761. rm(i,j,lsave,ico) = z
  1762. #ifdef with_budgets
  1763. ! stratospheric budget....
  1764. nzone=budg_dat(region)%nzong(i,j) !global budget
  1765. nzone_v=nzon_vg(lsave)
  1766. budstratg(nzone,nzone_v,ico)=budstratg(nzone,nzone_v,ico)+(z-rmold)/xmco*1e3 !mole
  1767. ! IF(ico ==1) sum_stratosphere(region) = sum_stratosphere(region) + z-rmold
  1768. #endif
  1769. ENDDO!i
  1770. ENDDO!j
  1771. ENDDO ! nudge levels
  1772. ENDIF
  1773. NULLIFY(rm)
  1774. NULLIFY(m)
  1775. ! end timing:
  1776. call GO_Timer_End( itim_appl, status )
  1777. IF_NOTOK_RETURN(status=1)
  1778. CALL goLabel()
  1779. status = 0
  1780. END SUBROUTINE BOUNDARY_APPLY
  1781. !EOC
  1782. END MODULE BOUNDARY