user_output_aerocom.F90 180 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291
  1. #define TRACEBACK write (gol,'("in ",a," (",a,i6,")")') 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. #define IF_NOTOK_MDF(action) if (status/=0) then; TRACEBACK; action; call MDF_CLose(fid,status); status=1; return; end if
  5. !
  6. #include "tm5.inc"
  7. !
  8. !-----------------------------------------------------------------------------
  9. ! TM5 !
  10. !-----------------------------------------------------------------------------
  11. !BOP
  12. !
  13. ! !MODULE: USER_OUTPUT_AEROCOM
  14. !
  15. ! !DESCRIPTION:
  16. !
  17. ! This module provides objects and methods for the AEROCOM-2 related
  18. ! diagnostics package. It is strongly related to the setup of the
  19. ! optics module.
  20. ! A list of parameters are defined for which daily averages are output
  21. ! (so far), result is one file per day containing 50 2d-fields and
  22. ! 4 3d-fields.
  23. !
  24. ! Life cycle(s):
  25. ! 1) output_aerocom_init:
  26. ! - if( newsrun ): - allocation and initialisation of output container
  27. ! (mixf%..., drydepos/wetdepos/emission, wdep_out)
  28. ! - initialisation of optics module
  29. ! - lookuptable
  30. ! - wavelengths
  31. ! - open output file (for today), initialise it and write attributes
  32. ! 2) output_aerocom_step:
  33. ! - gather tracer
  34. ! - add current state of model to containers
  35. ! (weighted by time since last call, --> period of validity)
  36. ! - do fluxes, surface concentrations and loads
  37. ! - do optics
  38. ! - aerocom_aopio_init: initialise and fill input parameters
  39. ! - optics::optics_calculate_aop:
  40. ! calculate optical properties (per wavelength)
  41. ! (take into account additional splitting, facilitated in
  42. ! optics::optics_calculate_aop)
  43. ! - fill containers for optical properties
  44. ! - free optics input parameters
  45. ! - fill aerocom output containers
  46. ! 3) output_aerocom_write:
  47. ! - collect_budgets:
  48. ! - use current budget containers (budemi, buddep, buddry)
  49. ! - compare with saved values and infer by that the increment
  50. ! - add to temporary output containers (wetdepos,drydepos,emission)
  51. ! - write output containers to file
  52. ! - close file
  53. ! 4) output_aerocom_done:
  54. ! - free allocated containers
  55. ! (mixf%..., drydepos/wetdepos/emission, wdep_out)
  56. !
  57. !\\
  58. !\\
  59. ! !INTERFACE:
  60. !
  61. MODULE USER_OUTPUT_AEROCOM
  62. !
  63. ! !USES:
  64. !
  65. use go, only : gol, goErr, goPr, goLabel
  66. use dims, only : nregions
  67. use optics, only : wavelendep
  68. use meteodata, only : global_lli, levi
  69. use MDF
  70. use TM5_DISTGRID, only : dgrid, Get_DistGrid, update_halo, update_halo_iband
  71. implicit none
  72. private
  73. !
  74. ! !PUBLIC MEMBER FUNCTIONS:
  75. !
  76. public :: output_aerocom_init
  77. public :: output_aerocom_step
  78. public :: output_aerocom_write
  79. public :: output_aerocom_done
  80. public :: wdep_out
  81. character(len=20), public :: aerocom_exper ! AeroCom experiment name
  82. character(len=20), public :: aerocom_freq ! AeroCom output frequency
  83. integer, public :: aerocom_dhour
  84. logical, parameter :: aai_output=.false.
  85. !
  86. ! !PRIVATE DATA MEMBERS:
  87. !
  88. character(len=*), parameter :: mname = 'user_output_aerocom'
  89. ! Changed naming convections to AeroCom Control 2015 experiment
  90. character(len=20), parameter :: f_dataid='aerocom3', f_model='TM5'
  91. character(len=20), parameter :: f_dimmix='global', f_dimstat='stations'
  92. !
  93. ! !PRIVATE TYPES:
  94. !
  95. type metafields
  96. integer :: itm5
  97. character(len=16) :: vname
  98. character(len=64) :: lname
  99. character(len=10) :: unit
  100. character(len=10) :: positive
  101. character(len=130) :: standard_name
  102. end type metafields
  103. type metafields2
  104. integer :: itm5
  105. character(len=17) :: vname
  106. character(len=64) :: lname
  107. character(len=10) :: unit
  108. character(len=130) :: standard_name
  109. end type metafields2
  110. type field3d
  111. type( metafields ) :: mf
  112. real, dimension(:,:,:), pointer :: field
  113. integer :: varid
  114. end type field3d
  115. type field2d
  116. type( metafields ) :: mf
  117. real, dimension(:,:), pointer :: field
  118. integer :: varid
  119. end type field2d
  120. type field1d
  121. type( metafields2 ) :: mf
  122. real, dimension(:,:), pointer :: field
  123. integer :: varid
  124. end type field1d
  125. type field0d
  126. type( metafields2 ) :: mf
  127. real, dimension(:), pointer :: field
  128. integer :: varid
  129. end type field0d
  130. type mixfile
  131. type( field3d ), dimension(:), pointer :: f3d
  132. type( field2d ), dimension(:), pointer :: f2d
  133. character(len=200) :: fname
  134. integer :: acct ! accumulation time
  135. integer :: funit ! unit number
  136. integer :: nlon ! x dimension of requested field
  137. integer :: nlat ! y dimension of requested field
  138. integer :: nlev ! z dimension of requested field
  139. real,dimension(:),pointer :: lon ! x dimension of requested field
  140. real,dimension(:),pointer :: lat ! y dimension of requested field
  141. real,dimension(:),pointer :: lev ! z dimension of requested field
  142. integer :: lonid ! x dimension id in nc
  143. integer :: latid ! y dimension id in nc
  144. integer :: levid ! z dimension id in nc
  145. integer :: timeid ! time dimension id in nc
  146. integer ::time_varid
  147. end type mixfile
  148. type(mixfile), dimension(nregions), save :: mixf
  149. type stationfile
  150. type( field1d ), dimension(:), pointer :: f1d
  151. type( field0d ), dimension(:), pointer :: f0d
  152. character(len=200) :: fname
  153. integer :: acct ! accumulation time
  154. integer :: funit ! unit number
  155. integer :: nstat ! dimension of requested field
  156. integer :: nlev ! z dimension of requested field
  157. integer :: levid ! z dimension id in nc
  158. integer :: timeid ! time dimension id in nc
  159. integer :: time_varid
  160. end type stationfile
  161. type(stationfile), dimension(nregions), save :: statf
  162. integer, dimension(5) :: statvarid
  163. integer::lon_varid
  164. integer::lat_varid
  165. type budgetstore
  166. real, dimension(:,:,:), allocatable :: f2dslast
  167. integer :: lasttime
  168. end type budgetstore
  169. type(budgetstore), dimension(nregions), save :: drydepos, wetdepos, emission
  170. ! wavelength information
  171. type(wavelendep), dimension(:), allocatable :: wdep_out
  172. integer, parameter :: statnamelen = 22
  173. integer :: snamelendim
  174. type station
  175. integer :: statnb ! station number
  176. character(len=statnamelen) :: statname ! station name
  177. real :: statlat ! geographic coordinate
  178. real :: statlon ! geographic coordinate
  179. real :: statalt ! geographic coordinate
  180. end type station
  181. type(station), dimension(:), allocatable :: statlist
  182. character(len=statnamelen), dimension(:), allocatable :: tmpstatnames
  183. type statintp
  184. integer,dimension(:),pointer :: ixr, ixl ! coordinates in current grid
  185. integer,dimension(:),pointer :: jyr, jyl ! coordinates in current grid
  186. integer,dimension(:),pointer :: lzr, lzl ! coordinates in current grid
  187. real, dimension(:),pointer :: wixl, wixr ! interpolation coefficients
  188. real, dimension(:),pointer :: wjyl, wjyr ! interpolation coefficients
  189. real, dimension(:),pointer :: wlzl, wlzr ! interpolation coefficients
  190. real, dimension(:),pointer :: tght ! terrain height at station
  191. end type statintp
  192. type(statintp), dimension(nregions) :: sintp
  193. logical, dimension(:), allocatable :: stat_active ! true if station is in processor domain
  194. integer :: stat_halo_loc ! 1 if halo cells are needed for the local processor, else 0
  195. integer :: stat_halo_glob ! 1 if halo cells are needed on any processor, else 0
  196. ! the region dimension has already been removed for the above three variables
  197. integer :: fid ! file id for IF_NOTOK_MDF macro
  198. integer :: access_mode ! netcdf-4 parallel access mode for distributed data
  199. ! generate output if true:
  200. logical :: okdebug = .true.
  201. ! reference time:
  202. integer, parameter :: time_reftime6(6) = (/2001,01,01,00,00,00/)
  203. character(len=*), parameter :: time_units = 'days since 2001-01-01 00:00'
  204. ! sizes of arrays
  205. integer, save :: ntracer_3d, ntracer_2d
  206. integer, save :: ntracer_1dstat, ntracer_0dstat, nstations
  207. integer, save :: nextra_1dstat
  208. ! index pointers for 1d/2d/3d fields in mixf
  209. integer, save :: temp, hus, airmass, pressure
  210. integer, save :: ec5503Daer , abs5503Daer , ec3503Daer , abs3503Daer , od550aer3d , humidity3d , deltaz3d
  211. integer, save :: ps , precip , sconcoa , sconcsoa , sconcbc , sconcso4 , sconcdust
  212. integer, save :: sconcss , sconcno3 , loadoa , loadsoa , loadbc , loadso4 , loaddust
  213. integer, save :: loadss , loadno3 , emioa , emibc , emiso2 , emiso4
  214. integer, save :: emidust , emidms , emiss , dryso2 , drybc , dryso4
  215. integer, save :: drydust , drydms , dryss , wetoa , wetsoa , wetbc , wetso2
  216. integer, save :: wetso4 , wetdust , wetdms , wetss , od550aer , od550so4, od550soa
  217. integer, save :: od550bc , od550oa , od550ss , od550dust , od550no3 , od550aerh2o
  218. integer, save :: od550lt1aer , od550lt1dust, od550lt1ss , abs550aer , ec550aer , asyaer
  219. integer, save :: ec550dryaer , abs550dryaer, asydryaer , ec550drylt1aer, abs550drylt1aer
  220. integer, save :: od440aer , od870aer , sconcmsa , dryoa , drysoa , sconcnh4
  221. integer, save :: abs440aer , ec440dryaer , abs440dryaer
  222. integer, save :: abs870aer , ec870dryaer , abs870dryaer
  223. integer, save :: od350aer , abs350aer
  224. integer, save :: ec550dryaer_stat, abs550dryaer_stat, asydryaer_stat
  225. integer, save :: ec550drylt1aer_stat, abs550drylt1aer_stat
  226. integer, save :: ec440dryaer_stat, abs440dryaer_stat
  227. integer, save :: ec870dryaer_stat, abs870dryaer_stat
  228. integer, save :: bso4nus, bso4ais, bso4acs, bso4cos, bbcais , bbcacs
  229. integer, save :: bbccos , bbcaii , bpomais, bpomacs, bpomcos, bpomaii
  230. integer, save :: bssacs , bsscos , bduacs , bducos , bduaci , bducoi, bno3_a
  231. integer, save :: bnus_n , bais_n , bacs_n , bcos_n , baii_n , baci_n
  232. integer, save :: bcoi_n , bh2onus, bh2oais, bh2oacs, bh2ocos
  233. integer, save :: tr2d_1, tr2d_2, tr2d_3, tr2d_4, tr2d_5, tr2d_6, tr2d_7, tr2d_8, tr2d_9, tr2d_10
  234. integer, save :: tr2d_11, tr2d_12, tr2d_13, tr2d_14, tr2d_15, tr2d_16, tr2d_17, tr2d_18, tr2d_19
  235. integer, save :: tr2d_20, tr2d_21, tr2d_22, tr2d_23
  236. integer, save :: cc01, cc02, cc03, cc04, cc05, cc06, cc07
  237. integer, save :: cc3d01, cc3d02, cc3d03, cc3d04, cc3d05, cc3d06, cc3d07
  238. integer, save :: rw01, rw02, rw03, rw04, rw05, rw06, rw07
  239. integer, save :: rd01, rd02, rd03, rd04, rd05, rd06, rd07
  240. integer, save :: h2o1, h2o2, h2o3, h2o4
  241. integer, save :: tr3d_1, tr3d_2, tr3d_3, tr3d_4, tr3d_5, tr3d_6, tr3d_7, tr3d_8, tr3d_9, tr3d_10
  242. integer, save :: tr3d_11, tr3d_12, tr3d_13, tr3d_14, tr3d_15, tr3d_16, tr3d_17, tr3d_18, tr3d_19
  243. integer, save :: tr3d_20, tr3d_21, tr3d_22, tr3d_23
  244. integer, save :: rw3d01, rw3d02, rw3d03, rw3d04, rw3d05, rw3d06, rw3d07
  245. integer, save :: rd3d01, rd3d02, rd3d03, rd3d04, rd3d05, rd3d06, rd3d07
  246. integer, save :: h2o3d1, h2o3d2, h2o3d3, h2o3d4
  247. !
  248. ! !REVISION HISTORY:
  249. ! 29 Nov 2010 - Achim Strunk - Creation
  250. ! 10 Oct 2014 - Twan van Noije - Adapted for TM5-mp
  251. ! 8 Dec 2016 - Tommi Bergman - Modifications for SOA
  252. !
  253. ! !REMARKS:
  254. ! (1) compiled only if with_m7 is used.
  255. !
  256. !EOP
  257. !------------------------------------------------------------------------
  258. contains
  259. !--------------------------------------------------------------------------
  260. ! TM5 !
  261. !--------------------------------------------------------------------------
  262. !BOP
  263. !
  264. ! !IROUTINE: OUTPUT_AEROCOM_INIT
  265. !
  266. ! !DESCRIPTION: Initialise various parameters, eg., station lists,
  267. ! wavelengths for optics and output containers.
  268. ! This routine should be called once per day, since fields
  269. ! are daily averages and one file per day is written.
  270. ! Additional tasks are done for newsrun==.true. .
  271. !\\
  272. !\\
  273. ! !INTERFACE:
  274. !
  275. subroutine output_aerocom_init(stat_output, status, iregion)
  276. !
  277. ! !USES:
  278. !
  279. !use MeteoData, only : sp_dat, set
  280. use chem_param, only : ntracet
  281. use chem_param, only : inus_n, iso4nus, isoanus, nmod
  282. use chem_param, only : iais_n, iso4ais, ibcais, ipomais, isoaais
  283. use chem_param, only : iacs_n, iso4acs, ibcacs, ipomacs, isoaacs, issacs, iduacs
  284. use chem_param, only : icos_n, iso4cos, ibccos, ipomcos, isoacos, isscos, iducos
  285. use chem_param, only : iaii_n, ibcaii, ipomaii, isoaaii
  286. use chem_param, only : iaci_n, icoi_n, iduaci, iducoi
  287. use chem_param, only : ino3_a, inh4, imsa
  288. use dims, only : nregions, newsrun, idatee, idatei
  289. use dims, only : region_name, parent, itau
  290. use dims, only : xbeg, xend, ybeg, yend, dx, dy, xref, yref
  291. use dims, only : zbeg, zend, dz, zref
  292. use global_data, only : region_dat, outdir
  293. use datetime, only : tau2date, date2tau
  294. use budget_global, only : nbud_vg
  295. use partools, only : MPI_INFO_NULL, localComm
  296. use optics, only : Optics_Init
  297. use datetime, only : date2tau
  298. use dims, only : mlen
  299. !
  300. ! !OUTPUT PARAMETERS:
  301. !
  302. integer, intent(out) :: status
  303. !
  304. ! !INPUT PARAMETERS:
  305. !
  306. logical, intent(in) :: stat_output ! true if stations output is requested
  307. integer, intent(in), optional :: iregion
  308. !
  309. ! !REVISION HISTORY:
  310. ! 29 Nov 2010 - Achim Strunk -
  311. !
  312. ! !REMARKS:
  313. !
  314. !EOP
  315. !------------------------------------------------------------------------
  316. !BOC
  317. character(len=*), parameter :: rname = mname//'/output_aerocom_init'
  318. ! --- local ------------------------------
  319. integer :: imr, jmr, lmr, access_mode_sta
  320. integer :: region, varid
  321. integer :: io, istat, i, j, n, sc
  322. integer :: i1, i2, j1, j2
  323. integer, dimension(6) :: idater
  324. character(len=10) :: idates
  325. character(len=16) :: lidates
  326. character(len=3) :: cwavel
  327. real :: reftime
  328. integer(kind=8) :: itaucur, itauref
  329. integer :: time_shift
  330. real :: dlat, dlon
  331. integer :: mlength ,lmon
  332. ! --- begin -------------------------------
  333. call goLabel(rname)
  334. ! access mode for distributed data (2d and 3d)
  335. #ifdef MPI
  336. #ifdef with_netcdf4_par
  337. access_mode = MDF_COLLECTIVE
  338. #else
  339. write(gol,'("AeroCom aerosol output requires netcdf4 with parallel access enabled")') ; call goErr
  340. TRACEBACK
  341. status=1; return
  342. #endif
  343. #else
  344. access_mode = MDF_INDEPENDENT
  345. #endif
  346. ! for station
  347. access_mode_sta = MDF_INDEPENDENT
  348. ! initialize (only once)
  349. if( newsrun ) then
  350. ! ensure that required meteo is loaded:
  351. ! call Set( sp_dat(region), status, used=.true. )
  352. ! set wavelength information
  353. ! wl: wavelength in microns
  354. ! split: whether to split into contributions from
  355. ! M7 constituents (incl. water)
  356. allocate( wdep_out( 4 ) )
  357. wdep_out(1)%wl = 0.550 ; wdep_out(1)%split = .true. ; wdep_out(1)%insitu = .true.
  358. wdep_out(2)%wl = 0.440 ; wdep_out(2)%split = .false. ; wdep_out(2)%insitu = .true.
  359. wdep_out(3)%wl = 0.870 ; wdep_out(3)%split = .false. ; wdep_out(3)%insitu = .true.
  360. wdep_out(4)%wl = 0.350 ; wdep_out(4)%split = .false. ; wdep_out(4)%insitu = .false.
  361. ! get the optics code prepared
  362. call Optics_Init(size(wdep_out), wdep_out, status )
  363. IF_NOTOK_RETURN(status=1)
  364. ! -----------------------
  365. ! parameters needed to reference the different 1d/2d/3d-fields
  366. ! (in order to avoid errors in referencing)
  367. ! finally, this list here simply determines the order in the output files
  368. ntracer_3d = 7!55
  369. if (aai_output) then
  370. ntracer_3d = ntracer_3d + 4
  371. endif
  372. ! -----------------------
  373. temp = 1 ! 3d
  374. hus = 2 ! 3d
  375. airmass = 3 ! 3d
  376. pressure = 4 ! 3d
  377. od550aer3d = 5 ! 3d
  378. deltaz3d = 6 ! 3d
  379. humidity3d = 7 ! 3d
  380. ec5503Daer = 8 ! 3d
  381. abs5503Daer = 9 ! 3d
  382. ec3503Daer = 10 ! 3d
  383. abs3503Daer = 11 ! 3d
  384. ntracer_2d = 71
  385. ps = 1 ! 2d
  386. precip = 2 ! 2d
  387. sconcoa = 3 ! 2d
  388. sconcbc = 4 ! 2d
  389. sconcso4 = 5 ! 2d
  390. sconcdust = 6 ! 2d
  391. sconcss = 7 ! 2d
  392. sconcno3 = 8 ! 2d
  393. sconcnh4 = 9 ! 2d
  394. sconcmsa = 10 ! 2d
  395. loadoa = 11 ! 2d
  396. loadbc = 12 ! 2d
  397. loadso4 = 13 ! 2d
  398. loaddust = 14 ! 2d
  399. loadss = 15 ! 2d
  400. loadno3 = 16 ! 2d
  401. emioa = 17 ! 2d
  402. emibc = 18 ! 2d
  403. emiso2 = 19 ! 2d
  404. emiso4 = 20 ! 2d
  405. emidust = 21 ! 2d
  406. emidms = 22 ! 2d
  407. emiss = 23 ! 2d
  408. dryso2 = 24 ! 2d
  409. dryoa = 25 ! 2d
  410. drybc = 26 ! 2d
  411. dryso4 = 27 ! 2d
  412. drydust = 28 ! 2d
  413. drydms = 29 ! 2d
  414. dryss = 30 ! 2d
  415. wetoa = 31 ! 2d
  416. wetbc = 32 ! 2d
  417. wetso2 = 33 ! 2d
  418. wetso4 = 34 ! 2d
  419. wetdust = 35 ! 2d
  420. wetdms = 36 ! 2d
  421. wetss = 37 ! 2d
  422. ! --- from here onwards keep consistent with order in optics (optics.F90)
  423. ! --- begin split order
  424. od550aer = 38 ! 2d
  425. od550so4 = 39 ! 2d
  426. od550bc = 40 ! 2d
  427. od550oa = 41 ! 2d
  428. od550soa = 42 ! 2d
  429. od550ss = 43 ! 2d
  430. od550dust = 44 ! 2d
  431. od550no3 = 45 ! 2d
  432. od550aerh2o = 46 ! 2d
  433. od550lt1aer = 47 ! 2d
  434. od550lt1dust = 48 ! 2d
  435. od550lt1ss = 49 ! 2d
  436. ! --- end split order
  437. abs550aer = 50 ! 2d
  438. asyaer = 51 ! 2d
  439. ec550aer = 52 ! 2d
  440. ! --- begin in-situ data order
  441. ec550dryaer = 53 ! 2d
  442. abs550dryaer = 54 ! 2d
  443. asydryaer = 55 ! 2d
  444. ec550drylt1aer = 56 ! 2d
  445. abs550drylt1aer = 57 ! 2d
  446. ! --- end in-situ data order
  447. !
  448. od440aer = 58 ! 2d
  449. abs440aer = 59 ! 2d
  450. ec440dryaer = 60 ! 2d
  451. abs440dryaer = 61 ! 2d
  452. !
  453. od870aer = 62 ! 2d
  454. abs870aer = 63 ! 2d
  455. ec870dryaer = 64 ! 2d
  456. abs870dryaer = 65 ! 2d
  457. !
  458. od350aer = 66 ! 2d
  459. abs350aer = 67 ! 2d
  460. !
  461. ! SOA output added to the end
  462. sconcsoa = 68
  463. loadsoa = 69
  464. drysoa = 70
  465. wetsoa = 71
  466. if (stat_output) then
  467. ! -----------------------
  468. ! set station information
  469. ! -----------------------
  470. ! this here is a kind of redundant coding, but it enables to easily check for correct
  471. ! information (instead of assigning dedicated arrays (name,lat,lon etc.) side by side)
  472. ec550dryaer_stat=38
  473. abs550dryaer_stat=39
  474. asydryaer_stat=40
  475. ec550drylt1aer_stat=41
  476. abs550drylt1aer_stat=42
  477. ec440dryaer_stat=43
  478. abs440dryaer_stat=44
  479. ec870dryaer_stat=45
  480. abs870dryaer_stat=46
  481. nextra_1dstat=3 ! temperature, specific humidity and pressure at model levels
  482. ntracer_1dstat=65!54!42+nextra_1dstat
  483. ntracer_0dstat=65!54!ntracer_1dstat+2 ! plus surface pressure and precipitation
  484. ! Adapted station list for AeroCom Phase III in-situ projects
  485. nstations = 90
  486. allocate( statlist( nstations ) )
  487. sc = 1
  488. statlist(sc) = station( sc, 'Alert ', 82.499, -62.342, 210.0 ); sc = sc + 1
  489. statlist(sc) = station( sc, 'Anmyeon-do ', 36.540, 126.330, 94.0 ); sc = sc + 1
  490. statlist(sc) = station( sc, 'Annaberg-Buchholz ', 50.570, 13.000, 545.0 ); sc = sc + 1
  491. statlist(sc) = station( sc, 'Appalachian State U. ', 36.213, -81.692, 1076.0 ); sc = sc + 1
  492. statlist(sc) = station( sc, 'Aspvreten ', 58.806, 17.388, 20.0 ); sc = sc + 1
  493. statlist(sc) = station( sc, 'Auchencorth Moss ', 55.793, -3.245, 260.0 ); sc = sc + 1
  494. statlist(sc) = station( sc, 'Backgarden ', 23.540, 113.060, -999.0 ); sc = sc + 1
  495. statlist(sc) = station( sc, 'Barrow ', 71.323, -156.611, 11.0 ); sc = sc + 1
  496. statlist(sc) = station( sc, 'BEO Moussala ', 42.179, 23.586, 2925.0 ); sc = sc + 1
  497. statlist(sc) = station( sc, 'Birkenes ', 58.388, 8.252, 190.0 ); sc = sc + 1
  498. statlist(sc) = station( sc, 'Bondville ', 40.050, -88.367, 213.0 ); sc = sc + 1
  499. statlist(sc) = station( sc, 'Bukit Kototabang ', -0.202, 100.318, 864.0 ); sc = sc + 1
  500. statlist(sc) = station( sc, 'Bosel ', 52.998, 7.943, 40.0 ); sc = sc + 1
  501. statlist(sc) = station( sc, 'Cabauw ', 51.971, 4.927, 1.0 ); sc = sc + 1
  502. statlist(sc) = station( sc, 'Cape Cod ', 40.070, -70.200, 43.0 ); sc = sc + 1
  503. statlist(sc) = station( sc, 'Cape Grim ', -40.682, 144.688, 94.0 ); sc = sc + 1
  504. statlist(sc) = station( sc, 'Cape Point ', -34.353, 18.490, 230.0 ); sc = sc + 1
  505. statlist(sc) = station( sc, 'Cape San Juan ', 18.381, -65.618, 65.0 ); sc = sc + 1
  506. statlist(sc) = station( sc, 'Chacaltaya ', -16.200, -68.100, 5320.0 ); sc = sc + 1
  507. statlist(sc) = station( sc, 'Danum Valley ', 4.981, 117.844, 426.0 ); sc = sc + 1
  508. statlist(sc) = station( sc, 'Demokritos ', 37.995, 23.816, 270.0 ); sc = sc + 1
  509. statlist(sc) = station( sc, 'East Trout Lake ', 54.350, -104.983, 500.0 ); sc = sc + 1
  510. statlist(sc) = station( sc, 'Egbert ', 44.230, -79.783, 255.0 ); sc = sc + 1
  511. statlist(sc) = station( sc, 'El Arenosillo ', 37.104, -6.734, 41.0 ); sc = sc + 1
  512. statlist(sc) = station( sc, 'El Tololo ', -30.173, -70.799, 2220.0 ); sc = sc + 1
  513. statlist(sc) = station( sc, 'Elandsfontein ', -25.533, 25.750, 1424.0 ); sc = sc + 1
  514. statlist(sc) = station( sc, 'Finokalia ', 35.333, 25.670, 250.0 ); sc = sc + 1
  515. statlist(sc) = station( sc, 'Giordan Lighthouse ', 36.073, 14.219, 167.0 ); sc = sc + 1
  516. statlist(sc) = station( sc, 'Gosan ', 33.280, 126.170, 72.0 ); sc = sc + 1
  517. statlist(sc) = station( sc, 'Graciosa ', 39.080, -28.030, 30.0 ); sc = sc + 1
  518. statlist(sc) = station( sc, 'Granada ', 37.164, -3.605, 680.0 ); sc = sc + 1
  519. statlist(sc) = station( sc, 'Hesselbach ', 48.540, 8.400, 51.4 ); sc = sc + 1
  520. statlist(sc) = station( sc, 'Harwell ', 51.573, -1.317, 137.0 ); sc = sc + 1
  521. statlist(sc) = station( sc, 'Hohenpeissenberg ', 47.802, 11.010, 985.0 ); sc = sc + 1
  522. statlist(sc) = station( sc, 'Hyytiala ', 61.847, 24.295, 181.0 ); sc = sc + 1
  523. statlist(sc) = station( sc, 'Illmitz ', 47.767, 16.767, 117.0 ); sc = sc + 1
  524. statlist(sc) = station( sc, 'Ispra ', 45.803, 8.627, 209.0 ); sc = sc + 1
  525. statlist(sc) = station( sc, 'Izana ', 28.309, -16.499, 2373.0 ); sc = sc + 1
  526. statlist(sc) = station( sc, 'Jungfraujoch ', 46.547, 7.985, 3580.0 ); sc = sc + 1
  527. statlist(sc) = station( sc, 'Kosetice ', 49.583, 15.083, 535.0 ); sc = sc + 1
  528. statlist(sc) = station( sc, 'K-Puszta ', 46.967, 19.583, 125.0 ); sc = sc + 1
  529. statlist(sc) = station( sc, 'Leibzig ', 51.353, 12.435, 126.0 ); sc = sc + 1
  530. statlist(sc) = station( sc, 'Leibzig-West ', 51.318, 12.298, 122.0 ); sc = sc + 1
  531. statlist(sc) = station( sc, 'Lille Valby ', 55.683, 12.117, 20.0 ); sc = sc + 1
  532. statlist(sc) = station( sc, 'London - N. Kensington', 51.521, -0.214, 27.0 ); sc = sc + 1
  533. statlist(sc) = station( sc, 'Lulin ', 23.470, 120.870, 2862.0 ); sc = sc + 1
  534. statlist(sc) = station( sc, 'Mace Head ', 53.326, -9.899, 5.0 ); sc = sc + 1
  535. statlist(sc) = station( sc, 'Madrid ', 40.450, -3.720, 669.0 ); sc = sc + 1
  536. statlist(sc) = station( sc, 'Manacapuro ', -3.210, -60.590, 50.0 ); sc = sc + 1
  537. statlist(sc) = station( sc, 'Manaus ', -2.595, -60.209, 45.0 ); sc = sc + 1
  538. statlist(sc) = station( sc, 'Mauna Loa ', 19.536, -155.576, 3397.0 ); sc = sc + 1
  539. statlist(sc) = station( sc, 'Melpitz ', 51.530, 12.930, 86.0 ); sc = sc + 1
  540. statlist(sc) = station( sc, 'Montseny ', 41.767, 2.350, 700.0 ); sc = sc + 1
  541. statlist(sc) = station( sc, 'Monte Cimone ', 44.167, 10.683, 2165.0 ); sc = sc + 1
  542. statlist(sc) = station( sc, 'Mount Waliguan ', 36.283, 100.900, 3810.0 ); sc = sc + 1
  543. statlist(sc) = station( sc, 'Nepal Climate Obs. ', 27.958, 86.815, 5079.0 ); sc = sc + 1
  544. statlist(sc) = station( sc, 'Nainital ', 29.360, 79.460, 1936.0 ); sc = sc + 1
  545. statlist(sc) = station( sc, 'Neuglobsov ', 53.143, 13.033, 62.0 ); sc = sc + 1
  546. statlist(sc) = station( sc, 'Neumayer ', -70.666, -8.266, 42.0 ); sc = sc + 1
  547. statlist(sc) = station( sc, 'Niamey ', 13.470, 2.170, 223.0 ); sc = sc + 1
  548. statlist(sc) = station( sc, 'Pallas ', 67.974, 24.116, 560.0 ); sc = sc + 1
  549. statlist(sc) = station( sc, 'Payerne ', 46.817, 6.950, 490.0 ); sc = sc + 1
  550. statlist(sc) = station( sc, 'Prague-Suchdol ', 50.130, 14.380, 270.0 ); sc = sc + 1
  551. statlist(sc) = station( sc, 'Preila ', 55.350, 21.067, 5.0 ); sc = sc + 1
  552. statlist(sc) = station( sc, 'Pt. Reyes ', 38.091, -122.957, 8.0 ); sc = sc + 1
  553. statlist(sc) = station( sc, 'Puy de Dome ', 45.772, 2.966, 1465.0 ); sc = sc + 1
  554. statlist(sc) = station( sc, 'Resolute Bay ', 74.717, -94.983, 64.0 ); sc = sc + 1
  555. statlist(sc) = station( sc, 'Sable Island ', 43.933, -60.017, 2.0 ); sc = sc + 1
  556. statlist(sc) = station( sc, 'Samoa ', -14.232, -170.563, 77.0 ); sc = sc + 1
  557. statlist(sc) = station( sc, 'Schauinsland ', 47.900, 7.917, 1205.0 ); sc = sc + 1
  558. statlist(sc) = station( sc, 'Shang Dianzi ', 40.390, 117.070, 294.0 ); sc = sc + 1
  559. statlist(sc) = station( sc, 'Shouxian ', 32.558, 116.782, 23.0 ); sc = sc + 1
  560. statlist(sc) = station( sc, 'SIRTA ', 48.709, 2.159, 160.0 ); sc = sc + 1
  561. statlist(sc) = station( sc, 'Sonnblick ', 47.054, 12.959, 3106.0 ); sc = sc + 1
  562. statlist(sc) = station( sc, 'South Pole ', -89.997, -24.800, 2841.0 ); sc = sc + 1
  563. statlist(sc) = station( sc, 'Southern Great Plains ', 36.617, -97.500, 318.0 ); sc = sc + 1
  564. statlist(sc) = station( sc, 'Storm Peak ', 40.455, -106.744, 3220.0 ); sc = sc + 1
  565. statlist(sc) = station( sc, 'Summit ', 72.580, -38.480, 3238.0 ); sc = sc + 1
  566. statlist(sc) = station( sc, 'Tahkuse ', 58.520, 24.940, 23.0 ); sc = sc + 1
  567. statlist(sc) = station( sc, 'Tiksi ', 71.586, 128.919, 8.0 ); sc = sc + 1
  568. statlist(sc) = station( sc, 'Trinidad Head ', 41.054, -124.151, 107.0 ); sc = sc + 1
  569. statlist(sc) = station( sc, 'Trollhaugen ', -72.012, 2.535, 1553.0 ); sc = sc + 1
  570. statlist(sc) = station( sc, 'Uto ', 59.783, 21.383, 7.0 ); sc = sc + 1
  571. statlist(sc) = station( sc, 'Varrio ', 67.767, 29.583, 400.0 ); sc = sc + 1
  572. statlist(sc) = station( sc, 'Vavihill ', 56.017, 13.150, 172.0 ); sc = sc + 1
  573. statlist(sc) = station( sc, 'Vielsalm ', 50.304, 6.001, 496.0 ); sc = sc + 1
  574. statlist(sc) = station( sc, 'Waldhof ', 52.802, 10.759, 74.0 ); sc = sc + 1
  575. statlist(sc) = station( sc, 'Whistler Mountain ', 50.059, -122.958, 2182.0 ); sc = sc + 1
  576. statlist(sc) = station( sc, 'Zeppelin ', 78.907, 11.889, 475.0 ); sc = sc + 1
  577. write(1001,*)sc
  578. statlist(sc) = station( sc, 'Zugspitze ', 47.417, 10.980, 2650.0 ); sc = sc + 1
  579. ! this copy is needed for the netcdf output of the 2d-character-array [statnamelen,nstations]
  580. allocate( tmpstatnames( nstations ) )
  581. tmpstatnames = statlist(:)%statname
  582. allocate(stat_active(nstations))
  583. stat_active(:)=.false.
  584. stat_halo_loc=0
  585. endif
  586. end if
  587. regionloop: do region = 1, nregions
  588. ! if region given, cycle if other region!
  589. if (present(iregion)) then
  590. if(iregion /= region) cycle regionloop
  591. endif
  592. imr = global_lli(region)%nlon
  593. jmr = global_lli(region)%nlat
  594. lmr = levi%nlev
  595. if( nbud_vg /= lmr ) then
  596. write(gol,*)'output_aerocom_init: nbud_vg /= lmr'; call goErr
  597. write(gol,*)'output_aerocom_init: YOU MUST ADD THE PROJ/BUDGET10 TO SRC CODE !!!!!'; call goErr
  598. TRACEBACK
  599. status=1; return
  600. end if
  601. ! initialize the output:
  602. if( newsrun ) then
  603. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  604. ! target structures for output
  605. allocate(mixf (region)%f3d(ntracer_3d))
  606. allocate(mixf (region)%f2d(ntracer_2d))
  607. ! allocate fields
  608. do i=1,ntracer_3d
  609. allocate( mixf(region)%f3d(i)%field(i1:i2,j1:j2,lmr) )
  610. end do
  611. do i=1,ntracer_2d
  612. allocate( mixf(region)%f2d(i)%field(i1:i2,j1:j2) )
  613. end do
  614. if (stat_output) then
  615. ! ---------
  616. ! find coordinates in grid and get interpolation coefficients
  617. ! ---------
  618. allocate( sintp(region)%ixl(nstations), sintp(region)%wixl(nstations), &
  619. sintp(region)%ixr(nstations), sintp(region)%wixr(nstations), &
  620. sintp(region)%jyl(nstations), sintp(region)%wjyl(nstations), &
  621. sintp(region)%jyr(nstations), sintp(region)%wjyr(nstations), &
  622. sintp(region)%lzl(nstations), sintp(region)%wlzl(nstations), &
  623. sintp(region)%lzr(nstations), sintp(region)%wlzr(nstations), &
  624. sintp(region)%tght(nstations) )
  625. call aerocom_get_statintp( region, status )
  626. IF_NOTOK_RETURN(status=1)
  627. allocate(statf(region)%f1d(ntracer_1dstat))
  628. allocate(statf(region)%f0d(ntracer_0dstat))
  629. do i=1,ntracer_1dstat
  630. allocate( statf(region)%f1d(i)%field(nstations,lmr) )
  631. end do
  632. do i=1,ntracer_0dstat
  633. allocate( statf(region)%f0d(i)%field(nstations) )
  634. end do
  635. endif
  636. ! 3d data
  637. mixf(region)%f3d(temp )%mf = metafields( -1 , 'temp ', 'Temperature ' , 'K ', '', 'air_temperature' )
  638. mixf(region)%f3d(hus )%mf = metafields( -1 , 'hus ', 'Specific Humidity ' , '1 ', '', 'specific_humidity' )
  639. mixf(region)%f3d(airmass )%mf = metafields( -1 , 'airmass ', 'Air Mass ' , 'kg m-2 ', '', 'atmosphere_mass_of_air_per_unit_area' )
  640. mixf(region)%f3d(pressure )%mf = metafields( -1 , 'pressure ', 'Pressure ' , 'Pa ', '', 'air_pressure' )
  641. if (aai_output) then
  642. mixf(region)%f3d(ec5503Daer )%mf = metafields( -1 , 'ec5503Daer ', 'Aerosol Extinction @550nm ' , 'm-1 ', '', 'atmosphere_extinction_due_to_ambient_aerosol' )
  643. mixf(region)%f3d(abs5503Daer )%mf = metafields( -1 , 'abs5503Daer ', 'Aerosol Absorption @550nm ' , 'm-1 ', '', 'atmosphere_absorption_due_to_ambient_aerosol' )
  644. mixf(region)%f3d(ec3503Daer )%mf = metafields( -1 , 'ec3503Daer ', 'Aerosol Extinction @350nm ' , 'm-1 ', '', 'atmosphere_extinction_due_to_ambient_aerosol' )
  645. mixf(region)%f3d(abs3503Daer )%mf = metafields( -1 , 'abs3503Daer ', 'Aerosol Absorption @350nm ' , 'm-1 ', '', 'atmosphere_absorption_due_to_ambient_aerosol' )
  646. endif
  647. mixf(region)%f3d(od550aer3d)%mf = metafields( -1 , 'od550aer3d', 'Layer Aerosol Optical Thickness ' , '1','', '' )
  648. mixf(region)%f3d(deltaz3d)%mf = metafields( -1 , 'deltaz3d', 'Layer Thickness ' , 'm','', '' )
  649. mixf(region)%f3d(humidity3d)%mf = metafields( -1 , 'humidity3d', 'Relative Humidity' , '1','', '' )
  650. ! 2d data
  651. mixf(region)%f2d(ps )%mf = metafields( -1 , 'ps ', 'Surface Air Pressure ' , 'Pa ', '', 'surface_air_pressure' )
  652. mixf(region)%f2d(precip )%mf = metafields( -1 , 'precip ', 'Precipitation ' , 'kg m-2 s-1', '', 'precipitation_flux' )
  653. mixf(region)%f2d(sconcoa )%mf = metafields( -1 , 'sconcoa ', 'Surface Concentration POM ' , 'kg m-3 ', '', 'mass_concentration_of_particulate_organic_matter_dry_aerosol_in_air' )
  654. mixf(region)%f2d(sconcbc )%mf = metafields( -1 , 'sconcbc ', 'Surface Concentration BC ' , 'kg m-3 ', '', 'mass_concentration_of_black_carbon_dry_aerosol_in_air' )
  655. mixf(region)%f2d(sconcso4 )%mf = metafields( -1 , 'sconcso4 ', 'Surface Concentration SO4 ' , 'kg m-3 ', '', 'mass_concentration_of_sulfate_dry_aerosol_in_air' )
  656. mixf(region)%f2d(sconcdust )%mf = metafields( -1 , 'sconcdust ', 'Surface Concentration Dust ' , 'kg m-3 ', '', 'mass_concentration_of_dust_dry_aerosol_in_air' )
  657. mixf(region)%f2d(sconcss )%mf = metafields( -1 , 'sconcss ', 'Surface Concentration SS ' , 'kg m-3 ', '', 'mass_concentration_of_seasalt_dry_aerosol_in_air' )
  658. mixf(region)%f2d(sconcno3 )%mf = metafields( -1 , 'sconcno3 ', 'Surface Concentration NO3 ' , 'kg m-3 ', '', 'mass_concentration_of_nitrate_dry_aerosol_in_air' )
  659. mixf(region)%f2d(sconcnh4 )%mf = metafields( -1 , 'sconcnh4 ', 'Surface Concentration NH4 ' , 'kg m-3 ', '', 'mass_concentration_of_ammonium_dry_aerosol_in_air' )
  660. mixf(region)%f2d(sconcmsa )%mf = metafields( -1 , 'sconcmsa ', 'Surface Concentration MSA ' , 'kg m-3 ', '', 'mass_concentration_of_methane_sulfonic_acid_in_air' )
  661. mixf(region)%f2d(loadoa )%mf = metafields( -1 , 'loadoa ', 'Load of POM ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_particulate_organic_matter_dry_aerosol' )
  662. mixf(region)%f2d(loadbc )%mf = metafields( -1 , 'loadbc ', 'Load of BC ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_black_carbon_dry_aerosol' )
  663. mixf(region)%f2d(loadso4 )%mf = metafields( -1 , 'loadso4 ', 'Load of SO4 ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_sulfate_dry_aerosol' )
  664. mixf(region)%f2d(loaddust )%mf = metafields( -1 , 'loaddust ', 'Load of Dust ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_dust_dry_aerosol' )
  665. mixf(region)%f2d(loadss )%mf = metafields( -1 , 'loadss ', 'Load of SS ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_seasalt_dry_aerosol' )
  666. mixf(region)%f2d(loadno3 )%mf = metafields( -1 , 'loadno3 ', 'Load of NO3 ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_nitrate_dry_aerosol' )
  667. mixf(region)%f2d(emioa )%mf = metafields( -1 , 'emioa ', 'Total Emission of POM ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_primary_particulate_organic_matter_dry_aerosol_due_to_emission' )
  668. mixf(region)%f2d(emibc )%mf = metafields( -1 , 'emibc ', 'Total Emission of BC ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_black_carbon_dry_aerosol_due_to_emission' )
  669. mixf(region)%f2d(emiso2 )%mf = metafields( -1 , 'emiso2 ', 'Total Emission of SO2 ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_sulfur_dioxide_due_to_emission' )
  670. mixf(region)%f2d(emiso4 )%mf = metafields( -1 , 'emiso4 ', 'Total Direct Emission of SO4 ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_sulfate_dry_aerosol_due_to_emission' )
  671. mixf(region)%f2d(emidust )%mf = metafields( -1 , 'emidust ', 'Total Emission of Dust ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_dust_dry_aerosol_due_to_emission' )
  672. mixf(region)%f2d(emidms )%mf = metafields( -1 , 'emidms ', 'Total Emission of DMS ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_dimethyl_sulfide_due_to_emission' )
  673. mixf(region)%f2d(emiss )%mf = metafields( -1 , 'emiss ', 'Total Emission of SeaSalt ' , 'kg m-2 s-1', 'up', 'tendency_of_atmosphere_mass_content_of_seasalt_dry_aerosol_due_to_emission' )
  674. mixf(region)%f2d(dryso2 )%mf = metafields( -1 , 'dryso2 ', 'Dry Deposition of SO2 ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_sulfur_dioxide_due_to_dry_deposition' )
  675. mixf(region)%f2d(dryoa )%mf = metafields( -1 , 'dryoa ', 'Dry Deposition of POM ' , 'kg m-2 s-1', 'down', &
  676. 'tendency_of_atmosphere_mass_content_of_primary_particulate_organic_matter_dry_aerosol_due_to_dry_deposition' )
  677. mixf(region)%f2d(drybc )%mf = metafields( -1 , 'drybc ', 'Dry Deposition of BC ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_black_carbon_dry_aerosol_due_to_dry_deposition' )
  678. mixf(region)%f2d(dryso4 )%mf = metafields( -1 , 'dryso4 ', 'Dry Deposition of SO4 ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_sulfate_dry_aerosol_due_to_dry_deposition' )
  679. mixf(region)%f2d(drydust )%mf = metafields( -1 , 'drydust ', 'Dry Deposition of Dust ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_dust_dry_aerosol_due_to_dry_deposition' )
  680. mixf(region)%f2d(drydms )%mf = metafields( -1 , 'drydms ', 'Dry Deposition of DMS ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_dimethyl_sulfide_due_to_dry_deposition' )
  681. mixf(region)%f2d(dryss )%mf = metafields( -1 , 'dryss ', 'Dry Deposition of SeaSalt ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_seasalt_dry_aerosol_due_to_dry_deposition' )
  682. mixf(region)%f2d(wetoa )%mf = metafields( -1 , 'wetoa ', 'Wet Deposition of POM ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_particulate_organic_matter_dry_aerosol_due_to_wet_deposition' )
  683. mixf(region)%f2d(wetbc )%mf = metafields( -1 , 'wetbc ', 'Wet Deposition of BC ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_black_carbon_dry_aerosol_due_to_wet_deposition' )
  684. mixf(region)%f2d(wetso2 )%mf = metafields( -1 , 'wetso2 ', 'Wet Deposition of SO2 ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_sulfur_dioxide_due_to_wet_deposition' )
  685. mixf(region)%f2d(wetso4 )%mf = metafields( -1 , 'wetso4 ', 'Wet Deposition of SO4 ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_sulfate_dry_aerosol_due_to_wet_deposition' )
  686. mixf(region)%f2d(wetdust )%mf = metafields( -1 , 'wetdust ', 'Wet Deposition of Dust ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_dust_dry_aerosol_due_to_wet_deposition' )
  687. mixf(region)%f2d(wetdms )%mf = metafields( -1 , 'wetdms ', 'Wet Deposition of DMS ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_dimethyl_sulfide_due_to_wet_deposition' )
  688. mixf(region)%f2d(wetss )%mf = metafields( -1 , 'wetss ', 'Wet Deposition of Seasalt ' , 'kg m-2 s-1', 'down', 'tendency_of_atmosphere_mass_content_of_seasalt_dry_aerosol_due_to_wet_deposition' )
  689. mixf(region)%f2d(od550aer )%mf = metafields( -1 , 'od550aer ', 'AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_ambient_aerosol' )
  690. mixf(region)%f2d(od550so4 )%mf = metafields( -1 , 'od550so4 ', 'SO4 AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_sulfate_ambient_aerosol' )
  691. mixf(region)%f2d(od550bc )%mf = metafields( -1 , 'od550bc ', 'Black Carbon AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_black_carbon_ambient_aerosol' )
  692. mixf(region)%f2d(od550oa )%mf = metafields( -1 , 'od550oa ', 'POM AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_particulate_organic_matter_ambient_aerosol' )
  693. mixf(region)%f2d(od550soa )%mf = metafields( -1 , 'od550soa ', 'SOA AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_secondary_organic_aerosol_ambient_aerosol' )
  694. mixf(region)%f2d(od550ss )%mf = metafields( -1 , 'od550ss ', 'SeaSalt AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_seasalt_ambient_aerosol' )
  695. mixf(region)%f2d(od550dust )%mf = metafields( -1 , 'od550dust ', 'Dust AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_dust_ambient_aerosol' )
  696. mixf(region)%f2d(od550no3 )%mf = metafields( -1 , 'od550no3 ', 'Nitrate AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_nitrate_ambient_aerosol' )
  697. mixf(region)%f2d(od550aerh2o )%mf = metafields( -1 , 'od550aerh2o ', 'Aerosol Water AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_water_in_ambient_aerosol' )
  698. mixf(region)%f2d(od550lt1aer )%mf = metafields( -1 , 'od550lt1aer ', 'Fine Mode AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_pm1_ambient_aerosol' )
  699. mixf(region)%f2d(od550lt1dust)%mf = metafields( -1 , 'od550lt1dust', 'Fine Mode Dust AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_dust_pm1_ambient_aerosol' )
  700. mixf(region)%f2d(od550lt1ss)%mf = metafields( -1 , 'od550lt1ss ', 'Fine Mode SeaSalt AOD@550nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_seasalt_pm1_ambient_aerosol' )
  701. mixf(region)%f2d(abs550aer )%mf = metafields( -1 , 'abs550aer ', 'Absorption AOD@550nm ' , '1 ', '', 'atmosphere_absorption_optical_thickness_due_to_ambient_aerosol' )
  702. mixf(region)%f2d(asyaer )%mf = metafields( -1 , 'asyaer ', 'Asymmetry Parameter ' , '1 ', '', 'atmosphere_asymmetry_parameter_ambient_aerosol' )
  703. mixf(region)%f2d(ec550aer )%mf = metafields( -1 , 'ec550aer ', 'Surface Ambient Aerosol Extinction@550nm' , 'm-1 ', '', 'surface_extinction_due_to_ambient_aerosol' )
  704. mixf(region)%f2d(ec550dryaer )%mf = metafields( -1 , 'ec550dryaer ', 'Surface Dry Aerosol Extinction@550 nm','m-1 ', '', 'surface_extinction_due_to_dry_aerosol' )
  705. mixf(region)%f2d(abs550dryaer)%mf = metafields( -1 , 'abs550dryaer', 'Surface Dry Aerosol Absorption@550 nm','m-1 ', '', 'surface_absorption_due_to_dry_aerosol' )
  706. mixf(region)%f2d(asydryaer )%mf = metafields( -1 , 'asydryaer ', 'Surface Dry Aersol Asymmetry Parameter' , '1 ', '', 'surface_asymmetry_parameter_dry_aerosol' )
  707. mixf(region)%f2d(ec550drylt1aer )%mf = metafields( -1 , 'ec550drylt1aer ', 'Surface Fine Mode Dry Aerosol Extinction@550 nm' , 'm-1', '', 'surface_extinction_due_to_pm1_dry_aerosol' )
  708. mixf(region)%f2d(abs550drylt1aer)%mf = metafields( -1 , 'abs550drylt1aer', 'Surface Fine Mode Dry Aerosol Absorption@550 nm' , 'm-1', '', 'surface_absorption_due_to_pm1_dry_aerosol' )
  709. mixf(region)%f2d(od440aer )%mf = metafields( -1 , 'od440aer ', 'AOD@440nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_ambient_aerosol' )
  710. mixf(region)%f2d(abs440aer )%mf = metafields( -1 , 'abs440aer ', 'Absorption AOD@440nm ' , '1 ', '', 'atmosphere_absorption_optical_thickness_due_to_ambient_aerosol' )
  711. mixf(region)%f2d(ec440dryaer )%mf = metafields( -1 , 'ec440dryaer ', 'Surface Dry Aerosol Extinction@440nm' , 'm-1 ', '', 'surface_extinction_due_to_dry_aerosol' )
  712. mixf(region)%f2d(abs440dryaer)%mf = metafields( -1 , 'abs440dryaer', 'Surface Dry Aerosol Absorption@440nm' , 'm-1 ', '', 'surface_absorption_due_to_dry_aerosol' )
  713. mixf(region)%f2d(od870aer )%mf = metafields( -1 , 'od870aer ', 'AOD@870nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_ambient_aerosol' )
  714. mixf(region)%f2d(abs870aer )%mf = metafields( -1 , 'abs870aer ', 'Absorption AOD@870nm ' , '1 ', '', 'atmosphere_absorption_optical_thickness_due_to_ambient_aerosol' )
  715. mixf(region)%f2d(ec870dryaer )%mf = metafields( -1 , 'ec870dryaer ', 'Surface Dry Aerosol Extinction@870nm' , 'm-1 ', '', 'surface_extinction_due_to_dry_aerosol' )
  716. mixf(region)%f2d(abs870dryaer)%mf = metafields( -1 , 'abs870dryaer', 'Surface Dry Aerosol Absorption@870nm' , 'm-1 ', '', 'surface_absorption_due_to_dry_aerosol' )
  717. mixf(region)%f2d(od350aer )%mf = metafields( -1 , 'od350aer ', 'AOD@350nm ' , '1 ', '', 'atmosphere_optical_thickness_due_to_ambient_aerosol' )
  718. mixf(region)%f2d(abs350aer )%mf = metafields( -1 , 'abs350aer ', 'Absorption AOD@350nm ' , '1 ', '', 'atmosphere_absorption_optical_thickness_due_to_ambient_aerosol' )
  719. mixf(region)%f2d(sconcsoa )%mf = metafields( -1 , 'sconcsoa ', 'Surface Concentration SOA ' , 'kg m-3 ', '', 'mass_concentration_of_secondary_particulate_organic_matter_dry_aerosol_in_air' )
  720. mixf(region)%f2d(loadsoa )%mf = metafields( -1 , 'loadsoa ', 'Load of SOA ' , 'kg m-2 ', '', 'atmosphere_mass_content_of_secondary_particulate_organic_matter_dry_aerosol' )
  721. mixf(region)%f2d(drysoa )%mf = metafields( -1 , 'drysoa ', 'Dry Deposition of SOA ' , 'kg m-2 s-1', 'down', &
  722. 'tendency_of_atmosphere_mass_content_of_secondary_particulate_organic_matter_dry_aerosol_due_to_dry_deposition' )
  723. mixf(region)%f2d(wetsoa )%mf = metafields( -1 , 'wetsoa ', 'Wet Deposition of SOA ' , 'kg m-2 s-1', 'down', &
  724. 'tendency_of_atmosphere_mass_content_of_secondary_particulate_organic_matter_dry_aerosol_due_to_wet_deposition' )
  725. if (stat_output) then
  726. ! 1d fields (stations)
  727. statf(region)%f1d( 1)%mf = metafields2( iso4nus, 'mmr1Dtr01', 'mmr of tracer 01' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  728. statf(region)%f1d( 2)%mf = metafields2( iso4ais, 'mmr1Dtr02', 'mmr of tracer 02' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  729. statf(region)%f1d( 3)%mf = metafields2( iso4acs, 'mmr1Dtr03', 'mmr of tracer 03' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  730. statf(region)%f1d( 4)%mf = metafields2( iso4cos, 'mmr1Dtr04', 'mmr of tracer 04' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  731. statf(region)%f1d( 5)%mf = metafields2( ibcais , 'mmr1Dtr05', 'mmr of tracer 05' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  732. statf(region)%f1d( 6)%mf = metafields2( ibcacs , 'mmr1Dtr06', 'mmr of tracer 06' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  733. statf(region)%f1d( 7)%mf = metafields2( ibccos , 'mmr1Dtr07', 'mmr of tracer 07' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  734. statf(region)%f1d( 8)%mf = metafields2( ibcaii , 'mmr1Dtr08', 'mmr of tracer 08' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  735. statf(region)%f1d( 9)%mf = metafields2( ipomais, 'mmr1Dtr09', 'mmr of tracer 09' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  736. statf(region)%f1d(10)%mf = metafields2( ipomacs, 'mmr1Dtr10', 'mmr of tracer 10' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  737. statf(region)%f1d(11)%mf = metafields2( ipomcos, 'mmr1Dtr11', 'mmr of tracer 11' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  738. statf(region)%f1d(12)%mf = metafields2( ipomaii, 'mmr1Dtr12', 'mmr of tracer 12' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  739. statf(region)%f1d(13)%mf = metafields2( issacs , 'mmr1Dtr13', 'mmr of tracer 13' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  740. statf(region)%f1d(14)%mf = metafields2( isscos , 'mmr1Dtr14', 'mmr of tracer 14' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  741. statf(region)%f1d(15)%mf = metafields2( iduacs , 'mmr1Dtr15', 'mmr of tracer 15' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  742. statf(region)%f1d(16)%mf = metafields2( iducos , 'mmr1Dtr16', 'mmr of tracer 16' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  743. statf(region)%f1d(17)%mf = metafields2( iduaci , 'mmr1Dtr17', 'mmr of tracer 17' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  744. statf(region)%f1d(18)%mf = metafields2( iducoi , 'mmr1Dtr18', 'mmr of tracer 18' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  745. statf(region)%f1d(19)%mf = metafields2( isoanus, 'mmr1Dtr19', 'mmr of tracer 19' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  746. statf(region)%f1d(20)%mf = metafields2( isoaais, 'mmr1Dtr20', 'mmr of tracer 20' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  747. statf(region)%f1d(21)%mf = metafields2( isoaacs, 'mmr1Dtr21', 'mmr of tracer 21' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  748. statf(region)%f1d(22)%mf = metafields2( isoacos, 'mmr1Dtr22', 'mmr of tracer 22' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  749. statf(region)%f1d(23)%mf = metafields2( isoaaii, 'mmr1Dtr23', 'mmr of tracer 23' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  750. statf(region)%f1d(24)%mf = metafields2( inus_n , 'conccn1Dmode01', 'number concentration of mode 01' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  751. statf(region)%f1d(25)%mf = metafields2( iais_n , 'conccn1Dmode02', 'number concentration of mode 02' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  752. statf(region)%f1d(26)%mf = metafields2( iacs_n , 'conccn1Dmode03', 'number concentration of mode 03' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  753. statf(region)%f1d(27)%mf = metafields2( icos_n , 'conccn1Dmode04', 'number concentration of mode 04' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  754. statf(region)%f1d(28)%mf = metafields2( iaii_n , 'conccn1Dmode05', 'number concentration of mode 05' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  755. statf(region)%f1d(29)%mf = metafields2( iaci_n , 'conccn1Dmode06', 'number concentration of mode 06' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  756. statf(region)%f1d(30)%mf = metafields2( icoi_n , 'conccn1Dmode07', 'number concentration of mode 07' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  757. statf(region)%f1d(31)%mf = metafields2( 1 , 'mmr1Daerh2o01 ', 'mmr of aerosol water of mode 01' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  758. statf(region)%f1d(32)%mf = metafields2( 2 , 'mmr1Daerh2o02 ', 'mmr of aerosol water of mode 02' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  759. statf(region)%f1d(33)%mf = metafields2( 3 , 'mmr1Daerh2o03 ', 'mmr of aerosol water of mode 03' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  760. statf(region)%f1d(34)%mf = metafields2( 4 , 'mmr1Daerh2o04 ', 'mmr of aerosol water of mode 04' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  761. statf(region)%f1d(35)%mf = metafields2( ino3_a , 'mmr1Dno3_a ', 'mmr of nitrate aerosol' , 'kg kg-1', 'mass_fraction_of_nitrate_dry_aerosol_in_air' )
  762. statf(region)%f1d(36)%mf = metafields2( inh4 , 'mmr1Dnh4 ', 'mmr of ammonium' , 'kg kg-1', 'mass_fraction_of_ammonium_dry_aerosol_in_air' )
  763. statf(region)%f1d(37)%mf = metafields2( imsa , 'mmr1Dmsa ', 'mmr of methane sulfonic acid' , 'kg kg-1', 'mass_fraction_of_methane_sulfonic_acid_in_air' )
  764. statf(region)%f1d(38)%mf = metafields2( -1 , 'ec550dry1Daer ', 'dry aerosol extinction at 550 nm' , 'm-1' , 'atmosphere_extinction_due_to_dry_aerosol' )
  765. statf(region)%f1d(39)%mf = metafields2( -1 , 'abs550dry1Daer', 'dry aerosol absorption at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  766. statf(region)%f1d(40)%mf = metafields2( -1 , 'asydry1Daer', 'dry aerosol asymmetry parameter' , '1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  767. statf(region)%f1d(41)%mf = metafields2( -1 , 'ec550dry1Dlt1aer', 'fine mode dry aerosol extinction at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  768. statf(region)%f1d(42)%mf = metafields2( -1 , 'abs550dry1Dlt1aer', 'fine mode dry aerosol absorption at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  769. statf(region)%f1d(43)%mf = metafields2( -1 , 'ec440dry1Daer', 'dry aerosol extinction at 440 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  770. statf(region)%f1d(44)%mf = metafields2( -1 , 'abs440dry1Daer', 'dry aerosol absorption at 440 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  771. statf(region)%f1d(45)%mf = metafields2( -1 , 'ec870dry1Daer', 'dry aerosol extinction at 870 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  772. statf(region)%f1d(46)%mf = metafields2( -1 , 'abs870dry1Daer', 'dry aerosol absorption at 870 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  773. statf(region)%f1d(47)%mf = metafields2( -1 , 'temp1D ', 'Temperature ' , 'K' , 'air_temperature' )
  774. statf(region)%f1d(48)%mf = metafields2( -1 , 'hus1D ', 'Specific Humidity ' , '1' , 'specific_humidity' )
  775. statf(region)%f1d(49)%mf = metafields2( -1 , 'pressure1D ', 'Pressure ' , 'Pa' , 'air_pressure' )
  776. statf(region)%f1d(50)%mf = metafields2( -1 , 'NOTps ', 'Surface Air Pressure ' , 'Pa ' , 'surface_air_pressure' )
  777. statf(region)%f1d(51)%mf = metafields2( -1 , 'NOTprecip ', 'Precipitation ' , 'kg m-2 s-1', 'precipitation_flux' )
  778. statf(region)%f1d(52)%mf = metafields2( -1 , 'RDRYnus1D ', 'rdry ' , 'm', 'precipitation_flux' )
  779. statf(region)%f1d(53)%mf = metafields2( -1 , 'RDRYais1D ', 'rdry ' , 'm', 'precipitation_flux' )
  780. statf(region)%f1d(54)%mf = metafields2( -1 , 'RDRYacs1D ', 'rdry ' , 'm', 'precipitation_flux' )
  781. statf(region)%f1d(55)%mf = metafields2( -1 , 'RDRYcos1D ', 'rdry ' , 'm', 'precipitation_flux' )
  782. statf(region)%f1d(56)%mf = metafields2( -1 , 'RDRYaii1D ', 'rdry ' , 'm', 'precipitation_flux' )
  783. statf(region)%f1d(57)%mf = metafields2( -1 , 'RDRYaci1D ', 'rdry ' , 'm', 'precipitation_flux' )
  784. statf(region)%f1d(58)%mf = metafields2( -1 , 'RDRYcoi1D ', 'rdry ' , 'm', 'precipitation_flux' )
  785. statf(region)%f1d(59)%mf = metafields2( -1 , 'RWETnus1D ', 'rwet ' , 'm', 'precipitation_flux' )
  786. statf(region)%f1d(60)%mf = metafields2( -1 , 'RWETais1D ', 'rwet ' , 'm', 'precipitation_flux' )
  787. statf(region)%f1d(61)%mf = metafields2( -1 , 'RWETacs1D ', 'rwet ' , 'm', 'precipitation_flux' )
  788. statf(region)%f1d(62)%mf = metafields2( -1 , 'RWETcos1D ', 'rwet ' , 'm', 'precipitation_flux' )
  789. statf(region)%f1d(63)%mf = metafields2( -1 , 'RWETaii1D ', 'rwet ' , 'm', 'precipitation_flux' )
  790. statf(region)%f1d(64)%mf = metafields2( -1 , 'RWETaci1D ', 'rwet ' , 'm', 'precipitation_flux' )
  791. statf(region)%f1d(65)%mf = metafields2( -1 , 'RWETcoi1D ', 'rwet ' , 'm', 'precipitation_flux' )
  792. ! 0d fields (stations)
  793. statf(region)%f0d( 1)%mf = metafields2( iso4nus, 'mmrtr01', 'mmr of tracer 01' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  794. statf(region)%f0d( 2)%mf = metafields2( iso4ais, 'mmrtr02', 'mmr of tracer 02' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  795. statf(region)%f0d( 3)%mf = metafields2( iso4acs, 'mmrtr03', 'mmr of tracer 03' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  796. statf(region)%f0d( 4)%mf = metafields2( iso4cos, 'mmrtr04', 'mmr of tracer 04' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  797. statf(region)%f0d( 5)%mf = metafields2( ibcais , 'mmrtr05', 'mmr of tracer 05' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  798. statf(region)%f0d( 6)%mf = metafields2( ibcacs , 'mmrtr06', 'mmr of tracer 06' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  799. statf(region)%f0d( 7)%mf = metafields2( ibccos , 'mmrtr07', 'mmr of tracer 07' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  800. statf(region)%f0d( 8)%mf = metafields2( ibcaii , 'mmrtr08', 'mmr of tracer 08' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  801. statf(region)%f0d( 9)%mf = metafields2( ipomais, 'mmrtr09', 'mmr of tracer 09' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  802. statf(region)%f0d(10)%mf = metafields2( ipomacs, 'mmrtr10', 'mmr of tracer 10' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  803. statf(region)%f0d(11)%mf = metafields2( ipomcos, 'mmrtr11', 'mmr of tracer 11' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  804. statf(region)%f0d(12)%mf = metafields2( ipomaii, 'mmrtr12', 'mmr of tracer 12' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  805. statf(region)%f0d(13)%mf = metafields2( issacs , 'mmrtr13', 'mmr of tracer 13' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  806. statf(region)%f0d(14)%mf = metafields2( isscos , 'mmrtr14', 'mmr of tracer 14' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  807. statf(region)%f0d(15)%mf = metafields2( iduacs , 'mmrtr15', 'mmr of tracer 15' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  808. statf(region)%f0d(16)%mf = metafields2( iducos , 'mmrtr16', 'mmr of tracer 16' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  809. statf(region)%f0d(17)%mf = metafields2( iduaci , 'mmrtr17', 'mmr of tracer 17' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  810. statf(region)%f0d(18)%mf = metafields2( iducoi , 'mmrtr18', 'mmr of tracer 18' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  811. statf(region)%f0d(19)%mf = metafields2( isoanus, 'mmrtr19', 'mmr of tracer 19' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  812. statf(region)%f0d(20)%mf = metafields2( isoaais, 'mmrtr20', 'mmr of tracer 20' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  813. statf(region)%f0d(21)%mf = metafields2( isoaacs, 'mmrtr21', 'mmr of tracer 21' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  814. statf(region)%f0d(22)%mf = metafields2( isoacos, 'mmrtr22', 'mmr of tracer 22' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  815. statf(region)%f0d(23)%mf = metafields2( isoaaii, 'mmrtr23', 'mmr of tracer 23' , 'kg kg-1', 'mass_fraction_of_tracer_dry_aerosol_in_air' )
  816. statf(region)%f0d(24)%mf = metafields2( inus_n , 'conccnmode01', 'number concentration of mode 01' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  817. statf(region)%f0d(25)%mf = metafields2( iais_n , 'conccnmode02', 'number concentration of mode 02' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  818. statf(region)%f0d(26)%mf = metafields2( iacs_n , 'conccnmode03', 'number concentration of mode 03' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  819. statf(region)%f0d(27)%mf = metafields2( icos_n , 'conccnmode04', 'number concentration of mode 04' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  820. statf(region)%f0d(28)%mf = metafields2( iaii_n , 'conccnmode05', 'number concentration of mode 05' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  821. statf(region)%f0d(29)%mf = metafields2( iaci_n , 'conccnmode06', 'number concentration of mode 06' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  822. statf(region)%f0d(30)%mf = metafields2( icoi_n , 'conccnmode07', 'number concentration of mode 07' , 'm-3' , 'number_concentration_of_ambient_aerosol_in_air' )
  823. statf(region)%f0d(31)%mf = metafields2( 1 , 'mmraerh2o01 ', 'mmr of aerosol water of mode 01' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  824. statf(region)%f0d(32)%mf = metafields2( 2 , 'mmraerh2o02 ', 'mmr of aerosol water of mode 02' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  825. statf(region)%f0d(33)%mf = metafields2( 3 , 'mmraerh2o03 ', 'mmr of aerosol water of mode 03' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  826. statf(region)%f0d(34)%mf = metafields2( 4 , 'mmraerh2o04 ', 'mmr of aerosol water of mode 04' , 'kg kg-1', 'mass_fraction_of_water_in_ambient_aerosol_in_air' )
  827. statf(region)%f0d(35)%mf = metafields2( ino3_a , 'mmrno3_a ', 'mmr of nitrate aerosol' , 'kg kg-1', 'mass_fraction_of_nitrate_dry_aerosol_in_air' )
  828. statf(region)%f0d(36)%mf = metafields2( inh4 , 'mmrnh4 ', 'mmr of ammonium' , 'kg kg-1', 'mass_fraction_of_ammonium_dry_aerosol_in_air' )
  829. statf(region)%f0d(37)%mf = metafields2( imsa , 'mmrmsa ', 'mmr of methane sulfonic acid' , 'kg kg-1', 'mass_fraction_of_methane_sulfonic_acid_in_air' )
  830. statf(region)%f0d(38)%mf = metafields2( -1 , 'ec550dryaer ', 'dry aerosol extinction at 550 nm' , 'm-1' , 'atmosphere_extinction_due_to_dry_aerosol' )
  831. statf(region)%f0d(39)%mf = metafields2( -1 , 'abs550dryaer', 'dry aerosol absorption at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  832. statf(region)%f0d(40)%mf = metafields2( -1 , 'asydryaer', 'dry aerosol asymmetry parameter' , '1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  833. statf(region)%f0d(41)%mf = metafields2( -1 , 'ec550drylt1aer', 'fine mode dry aerosol extinction at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  834. statf(region)%f0d(42)%mf = metafields2( -1 , 'abs550drylt1aer', 'fine mode dry aerosol absorption at 550 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  835. statf(region)%f0d(43)%mf = metafields2( -1 , 'ec440dryaer', 'dry aerosol extinction at 440 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  836. statf(region)%f0d(44)%mf = metafields2( -1 , 'abs440dryaer', 'dry aerosol absorption at 440 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  837. statf(region)%f0d(45)%mf = metafields2( -1 , 'ec870dryaer', 'dry aerosol extinction at 870 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  838. statf(region)%f0d(46)%mf = metafields2( -1 , 'abs870dryaer', 'dry aerosol absorption at 870 nm' , 'm-1' , 'atmosphere_absorption_due_to_dry_aerosol' )
  839. statf(region)%f0d(47)%mf = metafields2( -1 , 'temp ', 'Temperature ' , 'K' , 'air_temperature' )
  840. statf(region)%f0d(48)%mf = metafields2( -1 , 'hus ', 'Specific Humidity ' , '1' , 'specific_humidity' )
  841. statf(region)%f0d(49)%mf = metafields2( -1 , 'pressure ', 'Pressure ' , 'Pa' , 'air_pressure' )
  842. statf(region)%f0d(50)%mf = metafields2( -1 , 'ps ', 'Surface Air Pressure ' , 'Pa ' , 'surface_air_pressure' )
  843. statf(region)%f0d(51)%mf = metafields2( -1 , 'precip ', 'Precipitation ' , 'kg m-2 s-1', 'precipitation_flux' )
  844. statf(region)%f0d(52)%mf = metafields2( -1 , 'RDRYnus ', 'rdry ' , 'm', 'precipitation_flux' )
  845. statf(region)%f0d(53)%mf = metafields2( -1 , 'RDRYais ', 'rdry ' , 'm', 'precipitation_flux' )
  846. statf(region)%f0d(54)%mf = metafields2( -1 , 'RDRYacs ', 'rdry ' , 'm', 'precipitation_flux' )
  847. statf(region)%f0d(55)%mf = metafields2( -1 , 'RDRYcos ', 'rdry ' , 'm', 'precipitation_flux' )
  848. statf(region)%f0d(56)%mf = metafields2( -1 , 'RDRYaii ', 'rdry ' , 'm', 'precipitation_flux' )
  849. statf(region)%f0d(57)%mf = metafields2( -1 , 'RDRYaci ', 'rdry ' , 'm', 'precipitation_flux' )
  850. statf(region)%f0d(58)%mf = metafields2( -1 , 'RDRYcoi ', 'rdry ' , 'm', 'precipitation_flux' )
  851. statf(region)%f0d(59)%mf = metafields2( -1 , 'RWETnus ', 'rwet ' , 'm', 'precipitation_flux' )
  852. statf(region)%f0d(60)%mf = metafields2( -1 , 'RWETais ', 'rwet ' , 'm', 'precipitation_flux' )
  853. statf(region)%f0d(61)%mf = metafields2( -1 , 'RWETacs ', 'rwet ' , 'm', 'precipitation_flux' )
  854. statf(region)%f0d(62)%mf = metafields2( -1 , 'RWETcos ', 'rwet ' , 'm', 'precipitation_flux' )
  855. statf(region)%f0d(63)%mf = metafields2( -1 , 'RWETaii ', 'rwet ' , 'm', 'precipitation_flux' )
  856. statf(region)%f0d(64)%mf = metafields2( -1 , 'RWETaci ', 'rwet ' , 'm', 'precipitation_flux' )
  857. statf(region)%f0d(65)%mf = metafields2( -1 , 'RWETcoi ', 'rwet ' , 'm', 'precipitation_flux' )
  858. endif
  859. ! set global dimensions of fields for netcdf definitions
  860. mixf (region)%nlon = imr
  861. mixf (region)%nlat = jmr
  862. mixf (region)%nlev = lmr
  863. !allocate space for lon, lat, lev information
  864. allocate(mixf (region)%lon(imr))
  865. allocate(mixf (region)%lat(jmr))
  866. allocate(mixf (region)%lev(lmr))
  867. ! save the lat and lon data for use in output
  868. mixf (region)%lat=global_lli(region)%lat_deg
  869. mixf (region)%lon=global_lli(region)%lon_deg
  870. if (stat_output) then
  871. statf(region)%nstat = nstations
  872. statf(region)%nlev = lmr
  873. endif
  874. ! intermediate structures for budgets
  875. allocate(drydepos(region)%f2dslast(i1:i2,j1:j2,8))
  876. allocate(wetdepos(region)%f2dslast(i1:i2,j1:j2,8))
  877. allocate(emission(region)%f2dslast(i1:i2,j1:j2,7))
  878. ! these here are the initial budgets (monthly): 0.0
  879. drydepos(region)%f2dslast = 0.0
  880. wetdepos(region)%f2dslast = 0.0
  881. emission(region)%f2dslast = 0.0
  882. endif ! newsrun
  883. ! reset counters and accumulators
  884. mixf (region)%acct = 0
  885. do i = 1, ntracer_3d
  886. mixf(region)%f3d(i)%field = 0.0
  887. end do
  888. do i = 1, ntracer_2d
  889. mixf(region)%f2d(i)%field = 0.0
  890. end do
  891. if (stat_output) then
  892. ! stations
  893. statf(region)%acct = 0
  894. do i = 1, ntracer_1dstat
  895. statf(region)%f1d(i)%field = 0.0
  896. end do
  897. do i = 1, ntracer_0dstat
  898. statf(region)%f0d(i)%field = 0.0
  899. end do
  900. endif
  901. ! ----------------
  902. ! open NetCDF file (mixf)
  903. ! ----------------
  904. call tau2date(itau,idater)
  905. ! time (in days since 2001-01-01 00:00)
  906. call date2tau( time_reftime6, itauref )
  907. select case (trim(aerocom_freq))
  908. case ('hourly')
  909. if (aerocom_dhour >1) then
  910. write(idates, '(i4,3i2.2)') idater(1), idater(2), idater(3), idater(4)!+aerocom_dhour
  911. write(lidates, '(i4,"-",i2.2,"-",i2.2," ",i2.2,":00")') idater(1), idater(2), idater(3), idater(4)
  912. idater(5:6)=(/0,0/)
  913. else
  914. write(idates, '(i4,3i2.2)') idater(1), idater(2), idater(3), idater(4)+1
  915. write(lidates, '(i4,"-",i2.2,"-",i2.2," ",i2.2,":30")') idater(1), idater(2), idater(3), idater(4)
  916. idater(5:6) = (/30,0/)
  917. end if
  918. case ('daily')
  919. write(idates, '(i4,2i2.2)') idater(1), idater(2), idater(3)
  920. write(lidates, '(i4,"-",i2.2,"-",i2.2," 12:00")') idater(1), idater(2), idater(3)
  921. ! set noon (recommendations)
  922. idater(4:6) = (/12,0,0/)
  923. case ('monthly')
  924. ! for monthly files, set time to middle of the month
  925. write(idates, '(i4,i2.2)') idater(1), idater(2)
  926. mlength=mlen(idater(2))
  927. if ( mod(mlength,2) == 0 ) then
  928. idater(3:6) = (/mlength/2 + 1,0,0,0/)
  929. write(lidates, '(i4,"-",i2.2,"-",i2.2," 00:00")') idater(1), idater(2), idater(3)
  930. else
  931. idater(3:6) = (/(mlength+1)/2,12,0,0/)
  932. write(lidates, '(i4,"-",i2.2,"-",i2.2," 12:00")') idater(1), idater(2), idater(3)
  933. endif
  934. case default
  935. write (gol,'("Unknown AeroCom output frequency;")'); call goErr
  936. end select
  937. call date2tau( idater, itaucur )
  938. !move the timestamp in middle of the average period
  939. if (trim(aerocom_freq)=='hourly') then
  940. ! if average period is hour move the timestamp 30 min back
  941. if (aerocom_dhour>1) then
  942. time_shift=0
  943. else
  944. !put time stamp at the mid point of mean interval
  945. time_shift=(aerocom_dhour/2)*60
  946. end if
  947. else if (trim(aerocom_freq)=='daily') then
  948. ! if average period is day put the time stamp at midday
  949. time_shift = 12*60*60
  950. else if (trim(aerocom_freq)=='monthly') then
  951. ! assume 30 day months
  952. ! read the month length...
  953. lmon=30 !calc_days_in_month('greg',idater(1),idater(2))
  954. time_shift=0.5*lmon*60*60*24
  955. end if
  956. reftime = (itaucur - itauref-time_shift) / 86400.
  957. ! Changed file name convention to AeroCom Control 2015
  958. mixf(region)%fname = trim(outdir)//'/'//&
  959. trim(f_dataid)//'_'//&
  960. trim(f_model) //'_'//&
  961. trim(aerocom_exper)//'_'//&
  962. trim(f_dimmix)//'_'//&
  963. trim(idates) //'_'//&
  964. trim(aerocom_freq) //'.nc'
  965. #ifdef MPI
  966. ! overwrite existing files (clobber), provide MPI stuff:
  967. call MDF_Create( mixf(region)%fname, MDF_NETCDF4, MDF_REPLACE, mixf(region)%funit, status, &
  968. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  969. if (status/=0) then
  970. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  971. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  972. TRACEBACK; status=1; return
  973. end if
  974. #else
  975. ! overwrite existing files (clobber)
  976. call MDF_Create( mixf(region)%fname, MDF_NETCDF4, MDF_REPLACE, mixf(region)%funit, status )
  977. IF_NOTOK_RETURN(status=1)
  978. #endif
  979. if(okdebug) then
  980. write(gol,*) 'output_aerocom_init: File ', trim(mixf(region)%fname), ' opened ' ; call goPr
  981. endif
  982. ! global attributes
  983. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'title', 'Model output for AeroCom', status )
  984. IF_NOTOK_MDF(fid=mixf(region)%funit)
  985. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'source', 'TM5-mp', status )
  986. IF_NOTOK_MDF(fid=mixf(region)%funit)
  987. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'institution', 'Royal Netherlands Meteorological Institute (KNMI), De Bilt, The Netherlands)', status )
  988. IF_NOTOK_MDF(fid=mixf(region)%funit)
  989. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'contact' , 'Twan van Noije; noije@knmi.nl', status )
  990. IF_NOTOK_MDF(fid=mixf(region)%funit)
  991. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'project_id', 'AeroCom Phase 3', status )
  992. IF_NOTOK_MDF(fid=mixf(region)%funit)
  993. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'conventions', 'CF-1.0 - HTAP', status )
  994. IF_NOTOK_MDF(fid=mixf(region)%funit)
  995. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'date', lidates, status )
  996. IF_NOTOK_MDF(fid=mixf(region)%funit)
  997. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'time_units', time_units, status )
  998. IF_NOTOK_MDF(fid=mixf(region)%funit)
  999. call MDF_Put_Att( mixf(region)%funit, MDF_GLOBAL, 'references', 'http://tm5.sourceforge.net/', status )
  1000. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1001. ! define dimensions
  1002. call MDF_Def_Dim( mixf(region)%funit, 'lon', imr, mixf(region)%lonid, status )
  1003. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1004. call MDF_Def_Dim( mixf(region)%funit, 'lat', jmr, mixf(region)%latid, status )
  1005. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1006. call MDF_Def_Dim( mixf(region)%funit, 'alevel', lmr, mixf(region)%levid, status )
  1007. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1008. !Unlimited time causes a crash in the parallel NETCDF, when unlimited dimension is increased in the file
  1009. !4.4.0 may correct this, but for now netcdf v4.4.0 on cca is not working
  1010. call MDF_Def_Dim( mixf(region)%funit, 'time', 1, mixf(region)%timeid, status )
  1011. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1012. ! define dimension variables
  1013. ! longitude
  1014. call MDF_Def_Var( mixf(region)%funit, 'lon', MDF_DOUBLE, &
  1015. (/mixf(region)%lonid/), lon_varid, status )
  1016. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1017. call MDF_Put_Att( mixf(region)%funit,mixf(region)%lonid , 'units', 'degrees_east', status)
  1018. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1019. call MDF_Put_Att( mixf(region)%funit,mixf(region)%lonid , 'axis', 'X', status)
  1020. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1021. call MDF_Put_Att( mixf(region)%funit,mixf(region)%lonid , 'long_name', 'longitude', status)
  1022. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1023. call MDF_Put_Att( mixf(region)%funit,mixf(region)%lonid , 'standard_name', 'longitude', status)
  1024. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1025. ! Write out the longitudes
  1026. call MDF_Put_Var( mixf(region)%funit, lon_varid, mixf(region)%lon, status)
  1027. IF_NOTOK_MDF(fid=statf(region)%funit)
  1028. ! define latitude variable
  1029. call MDF_Def_Var( mixf(region)%funit, 'lat', MDF_DOUBLE, &
  1030. (/mixf(region)%latid/), lat_varid, status )
  1031. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1032. !write out the latitude to variable
  1033. call MDF_Put_Var( mixf(region)%funit, lat_varid, mixf(region)%lat, status)
  1034. IF_NOTOK_MDF(fid=statf(region)%funit)
  1035. call MDF_Put_Att( mixf(region)%funit,mixf(region)%latid , 'units', 'degrees_north', status)
  1036. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1037. call MDF_Put_Att( mixf(region)%funit,mixf(region)%latid , 'axis', 'Y', status)
  1038. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1039. call MDF_Put_Att( mixf(region)%funit,mixf(region)%latid , 'long_name', 'latitude', status)
  1040. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1041. call MDF_Put_Att( mixf(region)%funit,mixf(region)%latid , 'standard_name', 'latitude', status)
  1042. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1043. ! time
  1044. call MDF_Def_Var( mixf(region)%funit, 'time', MDF_DOUBLE, &
  1045. (/mixf(region)%timeid/), mixf(region)%time_varid, status )
  1046. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1047. call MDF_Put_Att( mixf(region)%funit,mixf(region)%time_varid , 'units', 'days since 2001-01-01 00:00:00', status)
  1048. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1049. !call MDF_Put_Att( mixf(region)%funit,mixf(region)%timeid , 'long_name', 'time', status)
  1050. !IF_NOTOK_MDF(fid=mixf(region)%funit)
  1051. call MDF_Put_Att( mixf(region)%funit,mixf(region)%time_varid , 'standard_name', 'time', status)
  1052. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1053. ! lev
  1054. !call MDF_Def_Var( mixf(region)%funit, 'longitude', MDF_DOUBLE, &
  1055. ! (/mixf(region)%lon, mixf(region)%nlat, mixf(region)%nlev/), varid, status )
  1056. !IF_NOTOK_MDF(fid=mixf(region)%funit)
  1057. ! define variables
  1058. do i = 1, ntracer_3d
  1059. call MDF_Def_Var( mixf(region)%funit, trim(mixf(region)%f3d(i)%mf%vname), MDF_FLOAT, &
  1060. (/mixf(region)%lonid, mixf(region)%latid, mixf(region)%levid, mixf(region)%timeid/), varid, status )
  1061. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1062. call MDF_Var_Par_Access( mixf(region)%funit, varid, access_mode, status )
  1063. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1064. call MDF_Put_Att( mixf(region)%funit, varid, 'long_name', trim(mixf(region)%f3d(i)%mf%lname), status )
  1065. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1066. call MDF_Put_Att( mixf(region)%funit, varid, 'standard_name', trim(mixf(region)%f3d(i)%mf%standard_name), status )
  1067. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1068. call MDF_Put_Att( mixf(region)%funit, varid, 'units', trim(mixf(region)%f3d(i)%mf%unit), status )
  1069. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1070. ! call MDF_Put_Att( mixf(region)%funit, varid, 'time', reftime, status )
  1071. ! IF_NOTOK_MDF(fid=mixf(region)%funit)
  1072. call MDF_Put_Att( mixf(region)%funit, varid, 'cell_methods', 'time: mean', status )
  1073. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1074. if( mixf(region)%f3d(i)%mf%positive /= '' ) then
  1075. call MDF_Put_Att( mixf(region)%funit, varid, 'positive', trim(mixf(region)%f3d(i)%mf%positive), status )
  1076. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1077. end if
  1078. mixf(region)%f3d(i)%varid = varid
  1079. end do
  1080. do i = 1, ntracer_2d
  1081. call MDF_Def_Var( mixf(region)%funit, trim(mixf(region)%f2d(i)%mf%vname), MDF_FLOAT, &
  1082. (/mixf(region)%lonid, mixf(region)%latid, mixf(region)%timeid/), varid, status )
  1083. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1084. call MDF_Var_Par_Access( mixf(region)%funit, varid, access_mode, status )
  1085. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1086. call MDF_Put_Att( mixf(region)%funit, varid, 'long_name', trim(mixf(region)%f2d(i)%mf%lname), status )
  1087. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1088. call MDF_Put_Att( mixf(region)%funit, varid, 'standard_name', trim(mixf(region)%f2d(i)%mf%standard_name), status )
  1089. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1090. call MDF_Put_Att( mixf(region)%funit, varid, 'units', trim(mixf(region)%f2d(i)%mf%unit), status )
  1091. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1092. ! call MDF_Put_Att( mixf(region)%funit, varid, 'time', reftime, status )
  1093. ! IF_NOTOK_MDF(fid=mixf(region)%funit)
  1094. call MDF_Put_Att( mixf(region)%funit, varid, 'cell_methods', 'time: mean', status )
  1095. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1096. if( mixf(region)%f2d(i)%mf%positive /= '' ) then
  1097. call MDF_Put_Att( mixf(region)%funit, varid, 'positive', trim(mixf(region)%f2d(i)%mf%positive), status )
  1098. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1099. end if
  1100. mixf(region)%f2d(i)%varid = varid
  1101. end do
  1102. call MDF_EndDef( mixf(region)%funit, status )
  1103. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1104. if (stat_output) then
  1105. ! ------------
  1106. ! station NetCDF file
  1107. ! ------------
  1108. statf(region)%fname = trim(outdir)//'/'//&
  1109. trim(f_dataid) //'_'//&
  1110. trim(f_model) //'_'//&
  1111. trim(aerocom_exper) //'_'//&
  1112. trim(f_dimstat)//'_'//&
  1113. trim(idates) //'_'//&
  1114. trim(aerocom_freq) //'.nc'
  1115. #ifdef MPI
  1116. ! overwrite existing files (clobber), provide MPI stuff:
  1117. call MDF_Create( statf(region)%fname, MDF_NETCDF4, MDF_REPLACE, statf(region)%funit, status, &
  1118. mpi_comm=localComm, mpi_info=MPI_INFO_NULL )
  1119. if (status/=0) then
  1120. write (gol,'("from creating NetCDF4 file for writing in parallel;")'); call goErr
  1121. write (gol,'("MDF module not compiled with netcdf4_par support ?")'); call goErr
  1122. TRACEBACK; status=1; return
  1123. end if
  1124. #else
  1125. ! overwrite existing files (clobber)
  1126. call MDF_Create( statf(region)%fname, MDF_NETCDF4, MDF_REPLACE, statf(region)%funit, status )
  1127. IF_NOTOK_RETURN(status=1)
  1128. #endif
  1129. if(okdebug) then
  1130. write(gol,*) ' output_aerocom_init: File ', trim(statf(region)%fname), ' opened '; call goPr
  1131. endif
  1132. ! global attributes
  1133. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'title', 'Model output for AeroCom', status )
  1134. IF_NOTOK_MDF(fid=statf(region)%funit)
  1135. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'source', 'TM5-mp', status )
  1136. IF_NOTOK_MDF(fid=statf(region)%funit)
  1137. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'institution', 'Royal Netherlands Meteorological Institute (KNMI), De Bilt, The Netherlands)', status )
  1138. IF_NOTOK_MDF(fid=statf(region)%funit)
  1139. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'contact', 'Twan van Noije; noije@knmi.nl', status )
  1140. IF_NOTOK_MDF(fid=statf(region)%funit)
  1141. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'project_id', 'AeroCom Phase 3', status )
  1142. IF_NOTOK_MDF(fid=statf(region)%funit)
  1143. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'conventions', 'CF-1.0 - HTAP', status )
  1144. IF_NOTOK_MDF(fid=statf(region)%funit)
  1145. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'date', lidates, status )
  1146. IF_NOTOK_MDF(fid=statf(region)%funit)
  1147. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'time_units', time_units, status )
  1148. IF_NOTOK_MDF(fid=statf(region)%funit)
  1149. call MDF_Put_Att( statf(region)%funit, MDF_GLOBAL, 'references', 'http://tm5.sourceforge.net/', status )
  1150. IF_NOTOK_MDF(fid=statf(region)%funit)
  1151. ! define dimensions
  1152. call MDF_Def_Dim( statf(region)%funit, 'station', nstations, statf(region)%nstat, status )
  1153. IF_NOTOK_MDF(fid=statf(region)%funit)
  1154. call MDF_Def_Dim( statf(region)%funit, 'stationname_len', statnamelen, snamelendim, status )
  1155. IF_NOTOK_MDF(fid=statf(region)%funit)
  1156. call MDF_Def_Dim( statf(region)%funit, 'alevel', lmr, statf(region)%levid, status )
  1157. IF_NOTOK_MDF(fid=statf(region)%funit)
  1158. call MDF_Def_Dim( statf(region)%funit, 'time', 1, statf(region)%timeid, status )
  1159. IF_NOTOK_MDF(fid=statf(region)%funit)
  1160. ! time
  1161. call MDF_Def_Var( statf(region)%funit, 'time', MDF_DOUBLE, &
  1162. (/statf(region)%timeid/), statf(region)%time_varid, status )
  1163. IF_NOTOK_MDF(fid=statf(region)%funit)
  1164. call MDF_Put_Att( statf(region)%funit,statf(region)%time_varid , 'units', 'days since 2001-01-01 00:00:00', status)
  1165. IF_NOTOK_MDF(fid=statf(region)%funit)
  1166. !call MDF_Put_Att( statf(region)%funit,statf(region)%timeid , 'long_name', 'time', status)
  1167. !IF_NOTOK_MDF(fid=statf(region)%funit)
  1168. call MDF_Put_Att( statf(region)%funit,statf(region)%time_varid , 'standard_name', 'time', status)
  1169. IF_NOTOK_MDF(fid=statf(region)%funit)
  1170. ! define variables
  1171. do i = 1, ntracer_1dstat
  1172. call MDF_Def_Var( statf(region)%funit, trim(statf(region)%f1d(i)%mf%vname), MDF_FLOAT, &
  1173. (/statf(region)%nstat,statf(region)%levid,statf(region)%timeid/), varid, status )
  1174. IF_NOTOK_MDF(fid=statf(region)%funit)
  1175. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1176. IF_NOTOK_MDF(fid=statf(region)%funit)
  1177. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', trim(statf(region)%f1d(i)%mf%lname), status )
  1178. IF_NOTOK_MDF(fid=statf(region)%funit)
  1179. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', trim(statf(region)%f1d(i)%mf%standard_name), status )
  1180. IF_NOTOK_MDF(fid=statf(region)%funit)
  1181. call MDF_Put_Att( statf(region)%funit, varid, 'units', trim(statf(region)%f1d(i)%mf%unit), status )
  1182. IF_NOTOK_MDF(fid=statf(region)%funit)
  1183. call MDF_Put_Att( statf(region)%funit, varid, 'time', reftime, status )
  1184. IF_NOTOK_MDF(fid=statf(region)%funit)
  1185. call MDF_Put_Att( statf(region)%funit, varid, 'cell_methods', 'time: mean', status )
  1186. IF_NOTOK_MDF(fid=statf(region)%funit)
  1187. statf(region)%f1d(i)%varid = varid
  1188. end do
  1189. do i = 1, ntracer_0dstat
  1190. write(2222,*)trim(statf(region)%f0d(i)%mf%vname)
  1191. call MDF_Def_Var( statf(region)%funit, trim(statf(region)%f0d(i)%mf%vname), MDF_FLOAT, &
  1192. (/statf(region)%nstat,statf(region)%timeid/), varid, status )
  1193. IF_NOTOK_MDF(fid=statf(region)%funit)
  1194. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1195. IF_NOTOK_MDF(fid=statf(region)%funit)
  1196. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', trim(statf(region)%f0d(i)%mf%lname), status )
  1197. IF_NOTOK_MDF(fid=statf(region)%funit)
  1198. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', trim(statf(region)%f0d(i)%mf%standard_name), status )
  1199. IF_NOTOK_MDF(fid=statf(region)%funit)
  1200. call MDF_Put_Att( statf(region)%funit, varid, 'units', trim(statf(region)%f0d(i)%mf%unit), status )
  1201. IF_NOTOK_MDF(fid=statf(region)%funit)
  1202. call MDF_Put_Att( statf(region)%funit, varid, 'time', reftime, status )
  1203. IF_NOTOK_MDF(fid=statf(region)%funit)
  1204. call MDF_Put_Att( statf(region)%funit, varid, 'cell_methods', 'time: mean', status )
  1205. IF_NOTOK_MDF(fid=statf(region)%funit)
  1206. statf(region)%f0d(i)%varid = varid
  1207. end do
  1208. ! station information (name, nb, lat, lon, alt)
  1209. call MDF_Def_Var( statf(region)%funit, 'stationname', MDF_CHAR, (/snamelendim,statf(region)%nstat/), varid, status )
  1210. IF_NOTOK_MDF(fid=statf(region)%funit)
  1211. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1212. IF_NOTOK_MDF(fid=statf(region)%funit)
  1213. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', 'station name', status )
  1214. IF_NOTOK_MDF(fid=statf(region)%funit)
  1215. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', 'station_name', status )
  1216. IF_NOTOK_MDF(fid=statf(region)%funit)
  1217. call MDF_Put_Att( statf(region)%funit, varid, 'units', '1', status )
  1218. IF_NOTOK_MDF(fid=statf(region)%funit)
  1219. statvarid(1) = varid
  1220. call MDF_Def_Var( statf(region)%funit, 'stationnb', MDF_INT, (/statf(region)%nstat/), varid, status )
  1221. IF_NOTOK_MDF(fid=statf(region)%funit)
  1222. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1223. IF_NOTOK_MDF(fid=statf(region)%funit)
  1224. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', 'station number', status )
  1225. IF_NOTOK_MDF(fid=statf(region)%funit)
  1226. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', 'station_nb', status )
  1227. IF_NOTOK_MDF(fid=statf(region)%funit)
  1228. call MDF_Put_Att( statf(region)%funit, varid, 'units', '1', status )
  1229. IF_NOTOK_MDF(fid=statf(region)%funit)
  1230. statvarid(2) = varid
  1231. call MDF_Def_Var( statf(region)%funit, 'stationlat', MDF_FLOAT, (/statf(region)%nstat/), varid, status )
  1232. IF_NOTOK_MDF(fid=statf(region)%funit)
  1233. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1234. IF_NOTOK_MDF(fid=statf(region)%funit)
  1235. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', 'location of station: station latitude', status )
  1236. IF_NOTOK_MDF(fid=statf(region)%funit)
  1237. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', 'stationlat', status )
  1238. IF_NOTOK_MDF(fid=statf(region)%funit)
  1239. call MDF_Put_Att( statf(region)%funit, varid, 'units', '1', status )
  1240. IF_NOTOK_MDF(fid=statf(region)%funit)
  1241. statvarid(3) = varid
  1242. call MDF_Def_Var( statf(region)%funit, 'stationlon', MDF_FLOAT, (/statf(region)%nstat/), varid, status )
  1243. IF_NOTOK_MDF(fid=statf(region)%funit)
  1244. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1245. IF_NOTOK_MDF(fid=statf(region)%funit)
  1246. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', 'location of station: station longitude', status )
  1247. IF_NOTOK_MDF(fid=statf(region)%funit)
  1248. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', 'stationlon', status )
  1249. IF_NOTOK_MDF(fid=statf(region)%funit)
  1250. call MDF_Put_Att( statf(region)%funit, varid, 'units', '1', status )
  1251. IF_NOTOK_MDF(fid=statf(region)%funit)
  1252. statvarid(4) = varid
  1253. call MDF_Def_Var( statf(region)%funit, 'stationalt', MDF_FLOAT, (/statf(region)%nstat/), varid, status )
  1254. IF_NOTOK_MDF(fid=statf(region)%funit)
  1255. call MDF_Var_Par_Access( statf(region)%funit, varid, access_mode_sta, status )
  1256. IF_NOTOK_MDF(fid=statf(region)%funit)
  1257. call MDF_Put_Att( statf(region)%funit, varid, 'long_name', 'location of station: station altitude', status )
  1258. IF_NOTOK_MDF(fid=statf(region)%funit)
  1259. call MDF_Put_Att( statf(region)%funit, varid, 'standard_name', 'stationalt', status )
  1260. IF_NOTOK_MDF(fid=statf(region)%funit)
  1261. call MDF_Put_Att( statf(region)%funit, varid, 'units', '1', status )
  1262. IF_NOTOK_MDF(fid=statf(region)%funit)
  1263. statvarid(5) = varid
  1264. call MDF_EndDef( statf(region)%funit, status )
  1265. IF_NOTOK_MDF(fid=statf(region)%funit)
  1266. ! put station information (note: behavior here is like if all procs write same data)
  1267. call MDF_Put_Var( statf(region)%funit, statvarid(1), tmpstatnames, status, start=(/ 1, 1/), count=(/ statnamelen,nstations /) )
  1268. IF_NOTOK_MDF(fid=statf(region)%funit)
  1269. call MDF_Put_Var( statf(region)%funit, statvarid(2), statlist(:)%statnb, status )
  1270. IF_NOTOK_MDF(fid=statf(region)%funit)
  1271. call MDF_Put_Var( statf(region)%funit, statvarid(3), statlist(:)%statlat, status )
  1272. IF_NOTOK_MDF(fid=statf(region)%funit)
  1273. call MDF_Put_Var( statf(region)%funit, statvarid(4), statlist(:)%statlon, status )
  1274. IF_NOTOK_MDF(fid=statf(region)%funit)
  1275. call MDF_Put_Var( statf(region)%funit, statvarid(5), statlist(:)%statalt, status )
  1276. IF_NOTOK_MDF(fid=statf(region)%funit)
  1277. endif
  1278. end do regionloop ! nregions
  1279. call goLabel() ; status = 0
  1280. end subroutine output_aerocom_init
  1281. !EOC
  1282. !--------------------------------------------------------------------------
  1283. ! TM5 !
  1284. !--------------------------------------------------------------------------
  1285. !BOP
  1286. !
  1287. ! !IROUTINE: OUTPUT_AEROCOM_DONE
  1288. !
  1289. ! !DESCRIPTION: Free parameters.
  1290. !\\
  1291. !\\
  1292. ! !INTERFACE:
  1293. !
  1294. subroutine output_aerocom_done(stat_output, status, iregion)
  1295. !
  1296. ! !USES:
  1297. !
  1298. ! !INPUT PARAMETERS:
  1299. !
  1300. logical, intent(in) :: stat_output ! true if stations output is requested
  1301. integer, intent(in), optional :: iregion
  1302. !
  1303. ! !OUTPUT PARAMETERS:
  1304. !
  1305. integer, intent(out) :: status
  1306. !
  1307. ! !REVISION HISTORY:
  1308. ! 29 Nov 2010 - Achim Strunk -
  1309. !
  1310. ! !REMARKS:
  1311. !
  1312. !EOP
  1313. !------------------------------------------------------------------------
  1314. !BOC
  1315. character(len=*), parameter :: rname = mname//'/output_aerocom_done'
  1316. integer :: i, region
  1317. ! --- begin -------------------------------------
  1318. call goLabel(rname)
  1319. deallocate( wdep_out )
  1320. regionloop: do region = 1, nregions
  1321. ! if region given, cycle if other region!
  1322. if (present(iregion)) then
  1323. if(iregion /= region) cycle regionloop
  1324. endif
  1325. do i=1,ntracer_3d
  1326. deallocate( mixf(region)%f3d(i)%field )
  1327. end do
  1328. do i=1,ntracer_2d
  1329. deallocate( mixf(region)%f2d(i)%field )
  1330. end do
  1331. deallocate( mixf (region)%f3d )
  1332. deallocate( mixf (region)%f2d )
  1333. deallocate( drydepos(region)%f2dslast )
  1334. deallocate( wetdepos(region)%f2dslast )
  1335. deallocate( emission(region)%f2dslast )
  1336. if (stat_output) then
  1337. ! stations
  1338. do i=1,ntracer_1dstat
  1339. deallocate( statf(region)%f1d(i)%field )
  1340. end do
  1341. do i=1,ntracer_0dstat
  1342. deallocate( statf(region)%f0d(i)%field )
  1343. end do
  1344. deallocate( statf(region)%f1d )
  1345. deallocate( statf(region)%f0d )
  1346. deallocate( sintp(region)%ixl, sintp(region)%wixl, sintp(region)%ixr, sintp(region)%wixr, &
  1347. sintp(region)%jyl, sintp(region)%wjyl, sintp(region)%jyr, sintp(region)%wjyr, &
  1348. sintp(region)%lzl, sintp(region)%wlzl, sintp(region)%lzr, sintp(region)%wlzr, &
  1349. sintp(region)%tght )
  1350. endif
  1351. end do regionloop
  1352. if (stat_output) then
  1353. deallocate( statlist )
  1354. deallocate( tmpstatnames )
  1355. deallocate( stat_active )
  1356. endif
  1357. call goLabel() ; status = 0
  1358. end subroutine output_aerocom_done
  1359. !EOC
  1360. !--------------------------------------------------------------------------
  1361. ! TM5 !
  1362. !--------------------------------------------------------------------------
  1363. !BOP
  1364. !
  1365. ! !IROUTINE: output_aerocom_write
  1366. !
  1367. ! !DESCRIPTION: This routines builds the average by dividing accumulated
  1368. ! data by stack counter. The results are written to file.
  1369. !\\
  1370. !\\
  1371. ! !INTERFACE:
  1372. !
  1373. subroutine output_aerocom_write(region, stat_output, status)
  1374. !
  1375. ! !USES:
  1376. !
  1377. use dims,only:itau
  1378. use datetime, only : tau2date, date2tau
  1379. ! !INPUT PARAMETERS:
  1380. !
  1381. integer, intent(in) :: region
  1382. logical, intent(in) :: stat_output ! true if stations output is requested
  1383. !
  1384. ! !OUTPUT PARAMETERS:
  1385. !
  1386. integer, intent(out) :: status
  1387. !
  1388. ! !REVISION HISTORY:
  1389. ! 29 Nov 2010 - Achim Strunk -
  1390. !
  1391. ! !REMARKS:
  1392. !
  1393. !EOP
  1394. !------------------------------------------------------------------------
  1395. !BOC
  1396. character(len=*), parameter :: rname = mname//'/output_aerocom_write'
  1397. integer :: i, imr, jmr, lmr
  1398. integer :: i1, i2, j1, j2, ilev
  1399. integer :: istat
  1400. ! Time definitions for Aerocom
  1401. real :: reftime
  1402. integer(kind=8) :: itauref
  1403. integer :: time_shift
  1404. ! --- begin -------------------------------------
  1405. call goLabel(rname)
  1406. ! grid size
  1407. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  1408. imr = i2-i1+1
  1409. jmr = j2-j1+1
  1410. lmr = levi%nlev
  1411. ! this here is already accumulated over the time period (day)
  1412. call collect_budgets( region, status )
  1413. IF_NOTOK_RETURN(status=1)
  1414. ! ---------------------
  1415. ! divide by accumulator
  1416. ! ---------------------
  1417. do i = 1, ntracer_3d
  1418. mixf(region)%f3d(i)%field = mixf(region)%f3d(i)%field / real( mixf(region)%acct )
  1419. end do
  1420. do i = 1, ntracer_2d
  1421. mixf(region)%f2d(i)%field = mixf(region)%f2d(i)%field / real( mixf(region)%acct )
  1422. end do
  1423. if (stat_output) then
  1424. ! stations
  1425. do istat = 1, nstations
  1426. if (stat_active(istat)) then
  1427. do i = 1, ntracer_1dstat
  1428. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) / real( statf(region)%acct )
  1429. end do
  1430. do i = 1, ntracer_0dstat
  1431. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) / real( statf(region)%acct )
  1432. end do
  1433. endif
  1434. end do
  1435. endif
  1436. select case (trim(aerocom_freq))
  1437. case ('hourly')
  1438. write(gol,'("---> AEROCOM diagnostics: write file for previous hour")'); call goPr
  1439. case ('daily')
  1440. write(gol,'("---> AEROCOM diagnostics: write file for previous day")'); call goPr
  1441. case ('monthly')
  1442. write(gol,'("---> AEROCOM diagnostics: write file for previous month")'); call goPr
  1443. end select
  1444. ! -------------
  1445. ! write to file
  1446. ! -------------
  1447. ! Ncfile needs a timestep
  1448. ! define the reference time
  1449. ! time (for now in days since 2001-01-01 00:00)
  1450. call date2tau( time_reftime6, itauref )
  1451. ! calculate reftime as fractional days from itauref, hence division by 86400
  1452. !call date2tau( idater, itaucur )
  1453. if (trim(aerocom_freq)=='hourly') then
  1454. ! if average period is hour move the timestamp 30 min back
  1455. if (aerocom_dhour>1) then
  1456. ! writing happpens at the next time step related to
  1457. ! accumulation, e.g. dhour=3, data accumulation for 00:00, but writing at 03:00
  1458. time_shift=aerocom_dhour*60*60
  1459. else
  1460. ! for 1hourly write time as half a step, although data is from the latter
  1461. !half of timestep
  1462. time_shift=30*60
  1463. end if
  1464. else if (trim(aerocom_freq)=='daily') then
  1465. ! if average period is hour move the timestamp 30 min back
  1466. time_shift = 12*60*60
  1467. else if (trim(aerocom_freq)=='monthly') then
  1468. ! assume 30 day months
  1469. time_shift=15*60*60*24
  1470. end if
  1471. reftime = (itau - itauref-time_shift) / 86400.
  1472. !reftime = (itau - itauref) / 86400.
  1473. !Add time stamp to current
  1474. !Currently only allows 1 step per file, needs to be extended
  1475. do i=1,ntracer_2d
  1476. call MDF_Put_Var( mixf(region)%funit, mixf(region)%f2d(i)%varid, mixf(region)%f2d(i)%field, status, start=(/i1,j1,1/), count=(/imr,jmr,1/) )
  1477. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1478. end do
  1479. do i=1,ntracer_3d
  1480. call MDF_Put_Var( mixf(region)%funit, mixf(region)%f3d(i)%varid, mixf(region)%f3d(i)%field, status, start=(/i1,j1,1,1/), count=(/imr,jmr,lmr,1/) )
  1481. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1482. end do
  1483. call MDF_Var_Par_Access( mixf(region)%funit, mixf(region)%time_varid, MDF_INDEPENDENT, status )
  1484. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1485. ! Write current reftime
  1486. call MDF_Put_Var( mixf(region)%funit, mixf(region)%time_varid,(/reftime/), status, start=(/1/),count=(/1/))
  1487. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1488. call MDF_Close( mixf(region)%funit, status )
  1489. IF_NOTOK_MDF(fid=mixf(region)%funit)
  1490. if (stat_output) then
  1491. ! stations
  1492. do istat = 1, nstations
  1493. if (stat_active(istat)) then
  1494. do i=1,ntracer_1dstat
  1495. call MDF_Put_Var( statf(region)%funit, statf(region)%f1d(i)%varid, statf(region)%f1d(i)%field(istat,:), &
  1496. status, start=(/istat,1,1/), count=(/1,lmr,1/) )
  1497. IF_NOTOK_MDF(fid=statf(region)%funit)
  1498. end do
  1499. do i=1,ntracer_0dstat
  1500. call MDF_Put_Var( statf(region)%funit, statf(region)%f0d(i)%varid, (/statf(region)%f0d(i)%field(istat)/), &
  1501. status, start=(/istat,1/), count=(/1,1/) )
  1502. IF_NOTOK_MDF(fid=statf(region)%funit)
  1503. end do
  1504. endif
  1505. end do
  1506. call MDF_Var_Par_Access( statf(region)%funit, statf(region)%time_varid, MDF_INDEPENDENT, status )
  1507. IF_NOTOK_MDF(fid=statf(region)%funit)
  1508. ! Write current reftime
  1509. call MDF_Put_Var( statf(region)%funit, statf(region)%time_varid,(/reftime/), status, start=(/1/),count=(/1/))
  1510. IF_NOTOK_MDF(fid=statf(region)%funit)
  1511. call MDF_Close( statf(region)%funit, status )
  1512. IF_NOTOK_MDF(fid=statf(region)%funit)
  1513. endif
  1514. call goLabel() ; status = 0
  1515. end subroutine output_aerocom_write
  1516. !EOC
  1517. !--------------------------------------------------------------------------
  1518. ! TM5 !
  1519. !--------------------------------------------------------------------------
  1520. !BOP
  1521. !
  1522. ! !IROUTINE: OUTPUT_AEROCOM_STEP
  1523. !
  1524. ! !DESCRIPTION: This is the accumulation routine. It is called following
  1525. ! the user specification aerocom.dhour in rc-file. It
  1526. ! evaluates the various diagnostics and does summing.
  1527. !\\
  1528. !\\
  1529. ! !INTERFACE:
  1530. !
  1531. subroutine output_aerocom_step( region, dhour, stat_output, status )
  1532. !
  1533. ! !USES:
  1534. !
  1535. use GO , only : TDate, NewDate, rTotal, operator(-)
  1536. use Grid , only : FPressure
  1537. use binas, only : rgas, rol, pi
  1538. use datetime, only : tau2date
  1539. use MeteoData, only : sp_dat, lsp_dat, cp_dat, m_dat
  1540. use MeteoData, only : temper_dat, humid_dat, gph_dat
  1541. use global_data, only : mass_dat, region_dat
  1542. use tracer_data, only : chem_dat
  1543. use dims, only : itaur
  1544. use chem_param, only : iso4acs, iso4cos, iduacs, iso4ais, ibccos, ibcaii, xmair
  1545. use chem_param, only : iso4nus, isscos, ino3_a, issacs, iducos, iduaci, nmod
  1546. use chem_param, only : iducoi, ibcacs, ipomcos, ipomaii, ibcais, ipomacs, ipomais
  1547. use chem_param, only : isoacos, isoaaii, isoaacs, isoaais, isoanus
  1548. use chem_param, only : imsa, inh4
  1549. use chem_param, only : ntracet,inus_n,iacs_n,icos_n,iais_n,iaii_n,iaci_n,icoi_n
  1550. use mo_aero_m7, only : nsol,nmod,dnacl,doc,dh2so4,dbc,ddust
  1551. use optics, only : optics_aop_get
  1552. use m7_data, only : h2o_mode, rw_mode, rwd_mode
  1553. use sedimentation, only : rh
  1554. !
  1555. ! !INPUT PARAMETERS:
  1556. !
  1557. integer, intent(in) :: region
  1558. integer, intent(in) :: dhour ! this is aerocom.dhour [hours]
  1559. logical, intent(in) :: stat_output ! true if stations output is requested
  1560. !
  1561. ! !OUTPUT PARAMETERS:
  1562. !
  1563. integer, intent(out) :: status
  1564. !
  1565. ! !REVISION HISTORY:
  1566. ! 29 Nov 2010 - Achim Strunk - Creation
  1567. !
  1568. ! !REMARKS:
  1569. !
  1570. !EOP
  1571. !------------------------------------------------------------------------
  1572. !BOC
  1573. character(len=*), parameter :: rname = mname//'/output_aerocom_step'
  1574. ! MPI arrays to gather fields.
  1575. real, dimension(:,:,:,:), pointer :: rm, rmc
  1576. real, dimension(:,:,:), allocatable, target :: mg
  1577. real, dimension(:), pointer :: dxyp
  1578. real, dimension(:,:,:), allocatable :: pres3d
  1579. integer :: i, j, k, imr, jmr, lmr, lwl, dtime
  1580. integer :: i1, i2, j1, j2
  1581. integer :: ie, je ! indices for subdomain extended with halo cells
  1582. integer, parameter :: l_halo=1
  1583. logical :: polar
  1584. integer :: istat, imode
  1585. real :: dens, load_tmp
  1586. Real, Dimension(:,:,:), Allocatable :: aop_output_ext ! extinctions
  1587. Real, Dimension(:,:), Allocatable :: aop_output_a ! single scattering albedo
  1588. Real, Dimension(:,:), Allocatable :: aop_output_g ! assymetry factor
  1589. Real, Dimension(:,:,:), Allocatable :: aop_output_add ! additional parameters
  1590. real, dimension(:,:,:,:,:), allocatable :: opt_ext
  1591. real, dimension(:,:,:,:), allocatable :: opt_a
  1592. real, dimension(:,:,:,:), allocatable :: opt_g
  1593. real, dimension(:,:,:,:,:), allocatable :: opt_add
  1594. real, dimension(:,:,:), allocatable :: volume
  1595. real, dimension(:,:), allocatable :: temp2d
  1596. real, dimension(:), allocatable :: temp_levels
  1597. integer :: ncontr, lvec, lct, l, indoffset, nwl,nn
  1598. integer :: nadd, nadd_max, indoffset_stat, indabs
  1599. integer :: iadd
  1600. real :: no3fac, wght, dwght, tabs
  1601. real :: e,es
  1602. integer,dimension(6) :: idate_f
  1603. type(TDate) :: t, t0
  1604. real :: time
  1605. ! --- begin -------------------------------
  1606. call goLabel(rname)
  1607. ! grid size
  1608. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2, hasNorthPole=polar )
  1609. imr = i2-i1+1
  1610. jmr = j2-j1+1
  1611. lmr = levi%nlev
  1612. nullify(rmc)
  1613. rmc => chem_dat(region)%rm
  1614. dxyp => region_dat(region)%dxyp
  1615. rm => mass_dat(region)%rm
  1616. ! get helping pressure field in 3d
  1617. ie=i2; je=j2
  1618. if (stat_output) then
  1619. if (stat_halo_glob.eq.1) then
  1620. CALL UPDATE_HALO( dgrid(region), sp_dat(region)%data(:,:,1), sp_dat(region)%halo, status)
  1621. IF_NOTOK_RETURN(status=1)
  1622. ! in the interpolation routine,
  1623. ! halo cells are only needed at the eastern or northern boundary of the subdomain
  1624. ie=i2+1
  1625. if (.not.polar) je=j2+1
  1626. endif
  1627. endif
  1628. allocate( pres3d(i1:ie,j1:je,lmr) )
  1629. ! fill mid level pressure
  1630. call FPressure( levi, sp_dat(region)%data(i1:ie,j1:je,1), pres3d, status )
  1631. IF_NOTOK_RETURN(status=1)
  1632. ! dtime is seconds per step
  1633. ! dtime will be taken as weight for summing up
  1634. ! (makes it fit for varying step lengths)
  1635. dtime = dhour * 3600.
  1636. ! sum up for later averaging
  1637. mixf (region)%acct = mixf (region)%acct + dtime
  1638. if (stat_output) then
  1639. statf(region)%acct = statf(region)%acct + dtime
  1640. endif
  1641. ! ----------------------
  1642. ! 3D meteo fields
  1643. ! ----------------------
  1644. ! temperature
  1645. mixf(region)%f3d(temp)%field = mixf(region)%f3d(temp)%field + dtime * temper_dat(region)%data(i1:i2,j1:j2,:)
  1646. ! specific humidity
  1647. mixf(region)%f3d(hus)%field = mixf(region)%f3d(hus)%field + dtime * humid_dat(region)%data(i1:i2,j1:j2,:)
  1648. ! air mass (kg -> kg/m2)
  1649. do j = j1, j2
  1650. mixf(region)%f3d(airmass)%field(:,j,:) = mixf(region)%f3d(airmass)%field(:,j,:) + &
  1651. dtime * m_dat(region)%data(i1:i2,j,:) / dxyp(j)
  1652. end do
  1653. ! pressure (already filled above)
  1654. mixf(region)%f3d(pressure)%field = mixf(region)%f3d(pressure)%field + dtime * pres3d
  1655. ! layer thickness
  1656. do l=1,lmr
  1657. mixf(region)%f3d(deltaz3d)%field(i1:i2,j1:j2,l) = mixf(region)%f3d(deltaz3d)%field(i1:i2,j1:j2,l) + dtime * (gph_dat(region)%data(i1:i2,j1:j2,l+1) - (gph_dat(region)%data(i1:i2,j1:j2,l)))
  1658. end do
  1659. do i=i1,i2
  1660. do j=j1,j2
  1661. do k=1,lmr
  1662. mixf(region)%f3d(humidity3d)%field(i,j,k)= mixf(region)%f3d(humidity3d)%field(i,j,k)+rh(region)%d3(i,j,k)*dtime
  1663. end do
  1664. end do
  1665. end do
  1666. ! ----------------------
  1667. ! cycle over horizontal domain
  1668. ! ----------------------
  1669. do j = j1, j2
  1670. do i = i1, i2
  1671. ! -----------------------
  1672. ! SURFACE FIELDS
  1673. ! -----------------------
  1674. k = 1
  1675. ! ----------------------
  1676. ! Physical Parameters
  1677. ! ----------------------
  1678. ! surface pressure [Pa]
  1679. mixf(region)%f2d(ps)%field(i,j) = mixf(region)%f2d(ps)%field(i,j) + dtime * sp_dat(region)%data(i,j,k)
  1680. ! precipitation ([m s-1] --> [kg m-2 s-1] with density of water `rol`)
  1681. mixf(region)%f2d(precip)%field(i,j) = mixf(region)%f2d(precip)%field(i,j) + dtime * (cp_dat(region)%data(i,j,k) + lsp_dat(region)%data(i,j,k)) * rol
  1682. ! density for conversion of aerosol mass densities ( ---> 1/m3 )
  1683. ! (conversion factor 1.E-03 is for g --> kg)
  1684. dens = pres3d(i,j,k) / temper_dat(region)%data(i,j,k) * xmair * 1.E-3 / (m_dat(region)%data(i,j,k) * Rgas)
  1685. ! ----------------------
  1686. ! Surface Concentrations in [kg m-3]
  1687. ! ----------------------
  1688. ! POM: (AIS + ACS + COS + AII)
  1689. mixf(region)%f2d(sconcoa)%field(i,j) = mixf(region)%f2d(sconcoa)%field(i,j) + dtime * &
  1690. dens * (rm(i,j,k,iPOMais) + rm(i,j,k,iPOMacs) + rm(i,j,k,iPOMcos) + rm(i,j,k,iPOMaii))
  1691. ! SOA: (NUS + AIS + ACS + COS + AII)
  1692. mixf(region)%f2d(sconcsoa)%field(i,j) = mixf(region)%f2d(sconcsoa)%field(i,j) + dtime * &
  1693. dens * (rm(i,j,k,iSOAnus) + rm(i,j,k,iSOAais) + rm(i,j,k,iSOAacs) + rm(i,j,k,iSOAcos) + rm(i,j,k,iSOAaii))
  1694. ! BC: (AIS + ACS + COS + AII)
  1695. mixf(region)%f2d(sconcbc)%field(i,j) = mixf(region)%f2d(sconcbc)%field(i,j) + dtime * &
  1696. dens * (rm(i,j,k,iBCais) + rm(i,j,k,iBCacs) + rm(i,j,k,iBCcos) + rm(i,j,k,iBCaii))
  1697. ! SO4: (NUS + AIS + ACS + COS)
  1698. mixf(region)%f2d(sconcso4)%field(i,j) = mixf(region)%f2d(sconcso4)%field(i,j) + dtime * &
  1699. dens * (rm(i,j,k,iSO4nus) + rm(i,j,k,iSO4ais) + rm(i,j,k,iSO4acs) + rm(i,j,k,iSO4cos))
  1700. ! Dust:
  1701. mixf(region)%f2d(sconcdust)%field(i,j) = mixf(region)%f2d(sconcdust)%field(i,j) + dtime * &
  1702. dens * (rm(i,j,k,iDUacs) + rm(i,j,k,iDUcos) + rm(i,j,k,iDUaci) + rm(i,j,k,iDUcoi))
  1703. ! Seasalt:
  1704. mixf(region)%f2d(sconcss)%field(i,j) = mixf(region)%f2d(sconcss)%field(i,j) + dtime * &
  1705. dens * (rm(i,j,k,iSSacs) + rm(i,j,k,iSScos))
  1706. ! NO3:
  1707. mixf(region)%f2d(sconcno3)%field(i,j) = mixf(region)%f2d(sconcno3)%field(i,j) + dtime * &
  1708. dens * rm(i,j,k,iNO3_a)
  1709. ! NH4:
  1710. mixf(region)%f2d(sconcnh4)%field(i,j) = mixf(region)%f2d(sconcnh4)%field(i,j) + dtime * &
  1711. dens * rm(i,j,k,iNH4)
  1712. ! MSA:
  1713. mixf(region)%f2d(sconcmsa)%field(i,j) = mixf(region)%f2d(sconcmsa)%field(i,j) + dtime * &
  1714. dens * rm(i,j,k,iMSA)
  1715. ! ----------------------
  1716. ! Load in [kg m-2]
  1717. ! ----------------------
  1718. do k = 1, lmr
  1719. ! POM: (AIS + ACS + COS + AII)
  1720. load_tmp = (rm(i,j,k,iPOMais) + rm(i,j,k,iPOMacs) + rm(i,j,k,iPOMcos) + rm(i,j,k,iPOMaii))
  1721. mixf(region)%f2d(loadoa)%field(i,j) = mixf(region)%f2d(loadoa)%field(i,j) + load_tmp * dtime / dxyp(j)
  1722. ! SOA: (NUS + AIS + ACS + COS + AII)
  1723. load_tmp = (rm(i,j,k,iSOAnus) + rm(i,j,k,iSOAais) + rm(i,j,k,iSOAacs) + rm(i,j,k,iSOAcos) + rm(i,j,k,iSOAaii))
  1724. mixf(region)%f2d(loadsoa)%field(i,j) = mixf(region)%f2d(loadsoa)%field(i,j) + load_tmp * dtime / dxyp(j)
  1725. ! BC: (AIS + ACS + COS + AII)
  1726. load_tmp = (rm(i,j,k,iBCais) + rm(i,j,k,iBCacs) + rm(i,j,k,iBCcos) + rm(i,j,k,iBCaii))
  1727. mixf(region)%f2d(loadbc)%field(i,j) = mixf(region)%f2d(loadbc)%field(i,j) + load_tmp * dtime / dxyp(j)
  1728. ! SO4: (NUS + AIS + ACS + COS)
  1729. load_tmp = (rm(i,j,k,iSO4nus) + rm(i,j,k,iSO4ais) + rm(i,j,k,iSO4acs) + rm(i,j,k,iSO4cos))
  1730. mixf(region)%f2d(loadso4)%field(i,j) = mixf(region)%f2d(loadso4)%field(i,j) + load_tmp * dtime / dxyp(j)
  1731. ! Dust: (ACS + COS + ACI + COI)
  1732. load_tmp = (rm(i,j,k,iDUacs) + rm(i,j,k,iDUcos) + rm(i,j,k,iDUaci) + rm(i,j,k,iDUcoi))
  1733. mixf(region)%f2d(loaddust)%field(i,j) = mixf(region)%f2d(loaddust)%field(i,j) + load_tmp * dtime / dxyp(j)
  1734. ! Seasalt: (ACS + COS)
  1735. load_tmp = (rm(i,j,k,iSSacs) + rm(i,j,k,iSScos))
  1736. mixf(region)%f2d(loadss)%field(i,j) = mixf(region)%f2d(loadss)%field(i,j) + load_tmp * dtime / dxyp(j)
  1737. ! NO3:
  1738. load_tmp = rm(i,j,k,iNO3_a)
  1739. mixf(region)%f2d(loadno3)%field(i,j) = mixf(region)%f2d(loadno3)%field(i,j) + load_tmp * dtime / dxyp(j)
  1740. end do ! k
  1741. end do ! i
  1742. end do ! j
  1743. if (stat_output) then
  1744. ! --------------------------------------
  1745. ! stations
  1746. ! --------------------------------------
  1747. if (stat_halo_glob.eq.1) then
  1748. CALL UPDATE_HALO( dgrid(region), rm, mass_dat(region)%halo, status)
  1749. IF_NOTOK_RETURN(status=1)
  1750. CALL UPDATE_HALO( dgrid(region), m_dat(region)%data, m_dat(region)%halo, status)
  1751. IF_NOTOK_RETURN(status=1)
  1752. CALL UPDATE_HALO( dgrid(region), gph_dat(region)%data, gph_dat(region)%halo, status)
  1753. IF_NOTOK_RETURN(status=1)
  1754. do imode = 1, nsol
  1755. CALL UPDATE_HALO( dgrid(region), h2o_mode(region,imode)%d3, h2o_mode(region,imode)%halo, status)
  1756. IF_NOTOK_RETURN(status=1)
  1757. end do
  1758. CALL UPDATE_HALO( dgrid(region), temper_dat(region)%data(:,:,:), temper_dat(region)%halo, status)
  1759. IF_NOTOK_RETURN(status=1)
  1760. CALL UPDATE_HALO( dgrid(region), humid_dat(region)%data(:,:,:), humid_dat(region)%halo, status)
  1761. IF_NOTOK_RETURN(status=1)
  1762. ! sp_dat has been updated earlier
  1763. CALL UPDATE_HALO( dgrid(region), cp_dat(region)%data(:,:,1), cp_dat(region)%halo, status)
  1764. IF_NOTOK_RETURN(status=1)
  1765. CALL UPDATE_HALO( dgrid(region), lsp_dat(region)%data(:,:,1), lsp_dat(region)%halo, status)
  1766. IF_NOTOK_RETURN(status=1)
  1767. CALL UPDATE_HALO_IBAND ( dgrid(region), dxyp(:), region_dat(region)%halo, status)
  1768. endif
  1769. allocate(volume(i1:ie,j1:je,1:lmr))
  1770. do j = j1, je
  1771. volume(i1:ie,j,1:lmr) = (gph_dat(region)%data(i1:ie,j,2:lmr+1)-gph_dat(region)%data(i1:ie,j,1:lmr)) * dxyp(j)
  1772. end do
  1773. do istat = 1, nstations
  1774. if (stat_active(istat)) then
  1775. ! masses
  1776. do i = 1, 23
  1777. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1778. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1779. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1780. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1781. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1782. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1783. end do
  1784. ! number densities
  1785. do i = 24, 24+nmod-1
  1786. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1787. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1788. volume(i1:ie,j1:je,1:lmr), region, istat )
  1789. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1790. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1791. volume(i1:ie,j1:je,1:lmr), region, istat )
  1792. end do
  1793. ! aerosol water of the wet modes
  1794. do i = 24+nmod, 24+nmod+nsol-1
  1795. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1796. aerocom_do_interp_1d( h2o_mode(region,statf(region)%f1d(i)%mf%itm5)%d3(i1:ie,j1:je,1:lmr) / &
  1797. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1798. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1799. aerocom_do_interp_0d( h2o_mode(region,statf(region)%f1d(i)%mf%itm5)%d3(i1:ie,j1:je,1:lmr) / &
  1800. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1801. end do
  1802. ! nitrate, ammonium and MSA
  1803. do i= 24+nmod+nsol,24+nmod+nsol+3-1
  1804. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1805. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1806. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1807. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1808. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  1809. m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  1810. end do
  1811. ! temperature
  1812. i=47!ntracer_1dstat-nextra_1dstat+1
  1813. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1814. aerocom_do_interp_1d( temper_dat(region)%data(i1:ie,j1:je,:), region, istat )
  1815. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1816. aerocom_do_interp_0d( temper_dat(region)%data(i1:ie,j1:je,:), region, istat )
  1817. ! specific humidity
  1818. i=i+1
  1819. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1820. aerocom_do_interp_1d( humid_dat(region)%data(i1:ie,j1:je,:), region, istat )
  1821. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1822. aerocom_do_interp_0d( humid_dat(region)%data(i1:ie,j1:je,:), region, istat )
  1823. ! pressure
  1824. i=i+1
  1825. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1826. aerocom_do_interp_1d( pres3d(i1:ie,j1:je,:), region, istat )
  1827. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1828. aerocom_do_interp_0d( pres3d(i1:ie,j1:je,:), region, istat )
  1829. ! surface pressure
  1830. i=i+1
  1831. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1832. aerocom_do_interp_surf( sp_dat(region)%data(i1:ie,j1:je,1), region, istat )
  1833. ! total precipitation
  1834. i=i+1
  1835. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1836. aerocom_do_interp_surf( ( cp_dat(region)%data(i1:ie,j1:je,1) + &
  1837. lsp_dat(region)%data(i1:ie,j1:je,1) ) *rol, region, istat )
  1838. ! rwet,rdry
  1839. ! mass/number in right
  1840. i=i+1
  1841. !
  1842. ! POM: (NUS + AIS + ACS + COS + AII)
  1843. !mixf(region)%f2d(sconcoa)%field(i,j) = mixf(region)%f2d(sconcoa)%field(i,j) + dtime * &
  1844. ! dens * (rm(i,j,k,iPOMnus) + rm(i,j,k,iPOMais) + rm(i,j,k,iPOMacs) + rm(i,j,k,iPOMcos) + rm(i,j,k,iPOMaii))
  1845. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1846. (3.0/(pi*4.0)*((aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4nus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1847. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSOAnus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc) / &
  1848. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,inus_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1849. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1850. (3.0/(pi*4.0)*((aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4nus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1851. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSOAnus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc) / &
  1852. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,inus_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1853. i=i+1
  1854. !
  1855. !AIS
  1856. !mixf(region)%f2d(sconcoa)%field(i,j) = mixf(region)%f2d(sconcoa)%field(i,j) + dtime * &
  1857. ! dens * (rm(i,j,k,iPOMnus) + rm(i,j,k,iPOMais) + rm(i,j,k,iPOMacs) + rm(i,j,k,iPOMcos) + rm(i,j,k,iPOMaii))
  1858. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1859. (3.0/(pi*4.0)*((aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4ais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1860. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMais)+rm(i1:i2,j1:je,1:lmr,iSOAais))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1861. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1862. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iais_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1863. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1864. (3.0/(pi*4.0)*((aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4ais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1865. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMais)+rm(i1:i2,j1:je,1:lmr,iSOAais))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1866. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1867. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iais_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1868. i=i+1
  1869. !
  1870. !ACS
  1871. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1872. (3.0/(pi*4.0)*((aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4acs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1873. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMacs)+rm(i1:i2,j1:je,1:lmr,iSOAacs))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1874. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1875. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSSacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1876. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1877. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iacs_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1878. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1879. (3.0/(pi*4.0)*((aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4acs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1880. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMacs)+rm(i1:i2,j1:je,1:lmr,iSOAacs))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1881. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1882. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSSacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1883. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1884. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iacs_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1885. i=i+1
  1886. !
  1887. !COS
  1888. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1889. (3.0/(pi*4.0)*((aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4cos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1890. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMcos)+rm(i1:i2,j1:je,1:lmr,iSOAcos))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1891. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1892. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSScos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1893. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1894. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,icos_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1895. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1896. (3.0/(pi*4.0)*((aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4cos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1897. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMcos)+rm(i1:i2,j1:je,1:lmr,iSOAcos))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1898. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1899. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSScos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1900. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1901. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,icos_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1902. i=i+1
  1903. !
  1904. !AII
  1905. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1906. (3.0/(pi*4.0)*((&
  1907. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMaii)+rm(i1:i2,j1:je,1:lmr,iSOAaii))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1908. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCaii)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1909. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iaii_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1910. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1911. (3.0/(pi*4.0)*((&
  1912. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMaii)+rm(i1:i2,j1:je,1:lmr,iSOAaii))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1913. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCaii)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1914. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iaii_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1915. i=i+1
  1916. !
  1917. !ACI
  1918. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1919. (3.0/(pi*4.0)*((&
  1920. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUaci)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1921. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iaci_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1922. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1923. (3.0/(pi*4.0)*((&
  1924. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUaci)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1925. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iaci_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1926. i=i+1
  1927. !
  1928. !ACI
  1929. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1930. (3.0/(pi*4.0)*((&
  1931. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUcoi)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1932. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,icoi_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1933. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1934. (3.0/(pi*4.0)*((&
  1935. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUcoi)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1936. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,icoi_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1937. i=i+1
  1938. !
  1939. ! NUS
  1940. !write(1011,*) aerocom_do_interp_1d( h2o_mode(region,1)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat )
  1941. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1942. (3.0/(pi*4.0)*((&
  1943. aerocom_do_interp_1d( h2o_mode(region,1)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat ) + &
  1944. aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4nus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1945. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSOAnus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc) / &
  1946. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,inus_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1947. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1948. (3.0/(pi*4.0)*((&
  1949. aerocom_do_interp_0d( h2o_mode(region,1)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat )+&
  1950. aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4nus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1951. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSOAnus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc) / &
  1952. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,inus_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1953. i=i+1
  1954. !
  1955. !AIS
  1956. !mixf(region)%f2d(sconcoa)%field(i,j) = mixf(region)%f2d(sconcoa)%field(i,j) + dtime * &
  1957. ! dens * (rm(i,j,k,iPOMnus) + rm(i,j,k,iPOMais) + rm(i,j,k,iPOMacs) + rm(i,j,k,iPOMcos) + rm(i,j,k,iPOMaii))
  1958. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1959. (3.0/(pi*4.0)*((&
  1960. aerocom_do_interp_1d( h2o_mode(region,2)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat ) + &
  1961. aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4ais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1962. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMais)+rm(i1:i2,j1:je,1:lmr,iSOAais))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1963. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1964. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iais_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1965. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1966. (3.0/(pi*4.0)*((&
  1967. aerocom_do_interp_0d( h2o_mode(region,2)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat )+&
  1968. aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4ais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1969. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMais)+rm(i1:i2,j1:je,1:lmr,iSOAais))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1970. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCais)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  1971. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iais_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1972. i=i+1
  1973. !
  1974. !ACS
  1975. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1976. (3.0/(pi*4.0)*((&
  1977. aerocom_do_interp_1d( h2o_mode(region,3)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat ) + &
  1978. aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4acs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1979. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMacs)+rm(i1:i2,j1:je,1:lmr,iSOAacs))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1980. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1981. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSSacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1982. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1983. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iacs_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1984. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  1985. (3.0/(pi*4.0)*((&
  1986. aerocom_do_interp_0d( h2o_mode(region,3)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat )+&
  1987. aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4acs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  1988. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMacs)+rm(i1:i2,j1:je,1:lmr,iSOAacs))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  1989. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  1990. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSSacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  1991. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUacs)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  1992. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iacs_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  1993. i=i+1
  1994. !
  1995. !COS
  1996. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  1997. (3.0/(pi*4.0)*((&
  1998. aerocom_do_interp_1d( h2o_mode(region,4)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat ) + &
  1999. aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4cos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  2000. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMcos)+rm(i1:i2,j1:je,1:lmr,iSOAcos))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  2001. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  2002. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iSScos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  2003. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2004. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,icos_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2005. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2006. (3.0/(pi*4.0)*((&
  2007. aerocom_do_interp_0d( h2o_mode(region,4)%d3(i1:ie,j1:je,1:lmr) / volume(i1:ie,j1:je,1:lmr), region, istat )+&
  2008. aerocom_do_interp_0d( rm(i1:i2,j1:je,1:lmr,iSO4cos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dh2so4 + &
  2009. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMcos)+rm(i1:i2,j1:je,1:lmr,iSOAcos))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  2010. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc + &
  2011. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iSScos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dnacl + &
  2012. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUcos)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2013. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,icos_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2014. i=i+1
  2015. !
  2016. !AII
  2017. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  2018. (3.0/(pi*4.0)*((&
  2019. aerocom_do_interp_1d((rm(i1:i2,j1:je,1:lmr,iPOMaii)+rm(i1:i2,j1:je,1:lmr,iSOAaii))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  2020. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iBCaii)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  2021. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iaii_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2022. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2023. (3.0/(pi*4.0)*((&
  2024. aerocom_do_interp_0d((rm(i1:i2,j1:je,1:lmr,iPOMaii)+rm(i1:i2,j1:je,1:lmr,iSOAaii))/ volume(i1:ie,j1:je,1:lmr) , region, istat )/doc + &
  2025. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iBCaii)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/dbc) / &
  2026. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iaii_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2027. i=i+1
  2028. !
  2029. !ACI
  2030. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  2031. (3.0/(pi*4.0)*((&
  2032. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUaci)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2033. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,iaci_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2034. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2035. (3.0/(pi*4.0)*((&
  2036. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUaci)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2037. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,iaci_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2038. i=i+1
  2039. !
  2040. !ACI
  2041. statf(region)%f1d(i)%field(istat,:) = statf(region)%f1d(i)%field(istat,:) + dtime * &
  2042. (3.0/(pi*4.0)*((&
  2043. aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iDUcoi)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2044. aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,icoi_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2045. statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2046. (3.0/(pi*4.0)*((&
  2047. aerocom_do_interp_0d(rm(i1:i2,j1:je,1:lmr,iDUcoi)/ volume(i1:ie,j1:je,1:lmr) , region, istat )/ddust) / &
  2048. aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,icoi_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )))**(1.0/3.0)
  2049. !statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2050. ! aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,statf(region)%f0d(i)%mf%itm5) / &
  2051. ! volume(i1:ie,j1:je,1:lmr), region, istat )
  2052. !write(1001,*) aerocom_do_interp_1d(rm(i1:i2,j1:je,1:lmr,iPOMnus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )
  2053. !write(1002,*) aerocom_do_interp_1d( rm(i1:i2,j1:je,1:lmr,iSO4nus)/ volume(i1:ie,j1:je,1:lmr) , region, istat )
  2054. !write(1003,*) aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,inus_n) / volume(i1:ie,j1:je,1:lmr) , region, istat )
  2055. !aerocom_do_interp_1d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  2056. ! m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  2057. ! statf(region)%f0d(i)%field(istat) = statf(region)%f0d(i)%field(istat) + dtime * &
  2058. ! aerocom_do_interp_0d( rm(i1:ie,j1:je,1:lmr,statf(region)%f1d(i)%mf%itm5) / &
  2059. ! m_dat(region)%data(i1:ie,j1:je,1:lmr), region, istat )
  2060. endif
  2061. end do
  2062. deallocate(volume)
  2063. endif
  2064. ! ---------------------
  2065. ! DO OPTICS IN PARALLEL
  2066. ! ---------------------
  2067. ! steps needed for that:
  2068. ! 1) according to the parallelisation there is different container sizes for
  2069. ! the results of the optics; these have to be allocated correctly
  2070. ! (aop_output_ext/a/g/add)
  2071. ! 2) the optics code is called (init/calculate_aop/done), see documentation
  2072. ! in the optics module
  2073. ! 3) the distributed fields (levels/tracers) are reshaped to global fields
  2074. ! (opt_ext/a/g/add), according to parallelisation
  2075. ! 4) fields are communicated such that the result contains the right
  2076. ! total extinctions, albedos, asymmetry factors etc.
  2077. ! 5) post-calculations (AOD etc.) are done and results are written
  2078. ! to mixf%../statf% containers as well as to the AOD dump files
  2079. ! 6) done...
  2080. ! ------------ REMARKS
  2081. ! IMPOSSIBLE / TOO EXPENSIVE (from the AEROCOM list of parameters for QUICKLOOK)
  2082. ! - gf @ 90% RH
  2083. ! - "AOD@550nm SOA", "AOD@550nm BB"
  2084. ! ---------------------------------
  2085. ! fill current M7 state into an appropriate container
  2086. ! and allocate output fields (ext,a,g)
  2087. ! ---------------------------------
  2088. ! ----- A T T E N T I O N ---------
  2089. ! in case for a 'split', we need a field big enough to contain
  2090. ! various contributions
  2091. ! (to be synchronously changed with optics_aop_calculate!!)
  2092. ! ncontr is here number of contributors
  2093. ! Total, SO4, BC, OC, SOA, SS, DU, NO3, Water, Fine, Fine Dust, Fine SS
  2094. ncontr = 12
  2095. ! Additional fields for surface dry aerosol
  2096. ! to be used for validation against in-situ data:
  2097. ! extinction, absorption, asymmetry factor
  2098. ! fine-mode contribution to extinction, absorption
  2099. nadd = 5
  2100. lvec = imr*jmr*lmr
  2101. ! allocate output fields for optics_calculate_aop
  2102. Allocate( aop_output_ext(lvec, size(wdep_out), ncontr ) ) ! extinction
  2103. Allocate( aop_output_a (lvec, size(wdep_out) ) ) ! single scattering albedo
  2104. Allocate( aop_output_g (lvec, size(wdep_out) ) ) ! asymmetry factor
  2105. Allocate( aop_output_add(lvec, size(wdep_out), nadd ) ) ! extinction/absorption due to dry aerosol at surface
  2106. call optics_aop_get(lvec, region, size(wdep_out), wdep_out, ncontr, .false., &
  2107. aop_output_ext, aop_output_a, aop_output_g, status, aop_output_add )
  2108. IF_NOTOK_RETURN(status=1)
  2109. ! allocate here result arrays for ext, abs, ssa, asymmetry parameter, additional parameters (PM10)
  2110. ! ncontr is number of contributors for 'split'
  2111. allocate( opt_ext( i1:i2, j1:j2, lmr, size(wdep_out), ncontr ) ) ; opt_ext = 0.0
  2112. allocate( opt_a ( i1:i2, j1:j2, lmr, size(wdep_out) ) ) ; opt_a = 0.0
  2113. allocate( opt_g ( i1:i2, j1:j2, lmr, size(wdep_out) ) ) ; opt_g = 0.0
  2114. if (stat_output) then
  2115. ! halo cells are needed for interpolation of opt_add
  2116. allocate( opt_add( i1-l_halo:i2+l_halo, j1-l_halo:j2+l_halo, lmr, size(wdep_out), nadd ) ) ; opt_add = 0.0
  2117. else
  2118. allocate( opt_add( i1:i2, j1:j2, lmr, size(wdep_out), nadd ) ) ; opt_add = 0.0
  2119. endif
  2120. ! ---------------------------------
  2121. ! unpack results from calculate_aop
  2122. ! ---------------------------------
  2123. do lwl = 1, size(wdep_out)
  2124. if( wdep_out(lwl)%split ) then
  2125. ! fill the array for the extinction coefficients of contributors
  2126. do lct = 1, ncontr
  2127. opt_ext(:,:,:,lwl,lct) = reshape( aop_output_ext(:,lwl,lct), (/imr,jmr,lmr/) )
  2128. end do
  2129. else
  2130. ! fill only total extinction coefficients
  2131. opt_ext(:,:,:,lwl,1) = reshape( aop_output_ext(:,lwl,1), (/imr,jmr,lmr/) )
  2132. endif
  2133. opt_a(:,:,:,lwl) = reshape( aop_output_a(:,lwl),(/imr,jmr,lmr/) )
  2134. opt_g(:,:,:,lwl) = reshape( aop_output_g(:,lwl),(/imr,jmr,lmr/) )
  2135. if ( wdep_out(lwl)%insitu ) then
  2136. ! additional fields for split
  2137. do lct = 1, nadd
  2138. opt_add(i1:i2,j1:j2,:,lwl,lct) = reshape( aop_output_add(:,lwl,lct),(/imr,jmr,lmr/) )
  2139. end do
  2140. endif
  2141. end do ! lwl
  2142. ! free temporary arrays for results from calculate_aop
  2143. deallocate( aop_output_ext )
  2144. deallocate( aop_output_a )
  2145. deallocate( aop_output_g )
  2146. deallocate( aop_output_add )
  2147. ! the following sections assume that for 550nm there is splitted information
  2148. ! available and that there is *NO* split for other wavelengths!
  2149. if( count( (wdep_out(:)%wl == 0.550) .and. wdep_out(:)%split ) /= 1 ) then
  2150. write(gol,*) 'user_output_aerocom: wrong setup with splitted AOD information.'; call goErr
  2151. TRACEBACK
  2152. status=1; return
  2153. end if
  2154. ! -------------------------------------
  2155. ! here additional calculations and
  2156. ! file writing begin
  2157. ! -------------------------------------
  2158. ! cycle over wavelengths
  2159. do lwl = 1, size(wdep_out)
  2160. if( wdep_out(lwl)%split ) then
  2161. ! for 550nm:
  2162. ! 1) AODs (35 - 44)
  2163. ! fill for contributors (total, SO4, BC, POM, SS, DU, NO3, H2O, fine, fine dust, fine SS)
  2164. ! 2) Absorption for 550nm (45)
  2165. ! Extinction is here the sum of scattering and absorption and
  2166. ! the scattering part is given by the albedo (SSA). Thus the
  2167. ! remainder is absorption: Abs = Ext * (1 - SSA)
  2168. indoffset = od550aer
  2169. allocate(temp2d(i1:i2,j1:j2))
  2170. allocate(temp_levels(1:lmr))
  2171. do lct = 1, ncontr
  2172. temp2d = 0.0
  2173. do j = j1, j2
  2174. do i = i1, i2
  2175. ! multiply with height elements and sum up
  2176. tabs = 0.0
  2177. temp_levels = 0.0
  2178. do l = 1, lmr
  2179. temp2d(i,j) = temp2d(i,j) + opt_ext(i,j,l,lwl,lct) * &
  2180. (gph_dat(region)%data(i,j,l+1) - &
  2181. gph_dat(region)%data(i,j,l ))
  2182. if( lct == 1 ) then
  2183. ! Absorption: do this only once for the totals
  2184. tabs = tabs + opt_ext(i,j,l,lwl,lct) * (1.0 - opt_a(i,j,l,lwl)) * &
  2185. (gph_dat(region)%data(i,j,l+1) - gph_dat(region)%data(i,j,l))
  2186. !3D od550aer
  2187. temp_levels(l)=temp_levels(l)+opt_ext(i,j,l,lwl,lct) * &
  2188. (gph_dat(region)%data(i,j,l+1) - &
  2189. gph_dat(region)%data(i,j,l ))
  2190. end if
  2191. end do
  2192. ! Absorption: do this only once for the totals
  2193. if( lct == 1 ) then
  2194. mixf(region)%f2d(abs550aer)%field(i,j) = &
  2195. mixf(region)%f2d(abs550aer)%field(i,j) + tabs * dtime
  2196. mixf(region)%f3d(od550aer3d)%field(i,j,:)= mixf(region)%f3d(od550aer3d)%field(i,j,:)+ temp_levels(:) * dtime
  2197. end if
  2198. end do
  2199. end do
  2200. ! this here is AODs for different contributors, splitted by volumes
  2201. mixf(region)%f2d(indoffset+lct-1)%field = &
  2202. mixf(region)%f2d(indoffset+lct-1)%field + temp2d * dtime
  2203. end do
  2204. deallocate( temp2d )
  2205. ! Asymmetry Parameter, weighted by AOD and single scattering albedo at each layer
  2206. allocate(temp2d(i1:i2,j1:j2)) ; temp2d = 0.0
  2207. do j = j1, j2
  2208. do i = i1, i2
  2209. wght = 0.0
  2210. do l = 1, lmr
  2211. dwght = opt_ext(i,j,l,lwl,1) * (gph_dat(region)%data(i,j,l+1) - gph_dat(region)%data(i,j,l )) * opt_a(i,j,l,lwl)
  2212. temp2d(i,j) = temp2d(i,j) + opt_g(i,j,l,lwl) * dwght
  2213. wght = wght + dwght
  2214. end do
  2215. temp2d(i,j) = temp2d(i,j) / wght
  2216. end do
  2217. end do
  2218. mixf(region)%f2d(asyaer)%field = mixf(region)%f2d(asyaer)%field + temp2d * dtime
  2219. deallocate(temp2d)
  2220. ! Surface Ambient Aerosol Extinction
  2221. mixf(region)%f2d(ec550aer)%field = &
  2222. mixf(region)%f2d(ec550aer)%field + opt_ext(:,:,1,lwl,1) * dtime
  2223. else
  2224. ! for 440/870/350 nm:
  2225. ! 1) fill total AOD and AAOD and write to containers
  2226. ! 2) dump AOD fields
  2227. if ( wdep_out(lwl)%wl == 0.440 ) then
  2228. indoffset = od440aer
  2229. indabs = abs440aer
  2230. elseif ( wdep_out(lwl)%wl == 0.550 ) then
  2231. indoffset = od550aer
  2232. indabs = abs550aer
  2233. elseif ( wdep_out(lwl)%wl == 0.870 ) then
  2234. indoffset = od870aer
  2235. indabs = abs870aer
  2236. elseif ( wdep_out(lwl)%wl == 0.350 ) then
  2237. indoffset = od350aer
  2238. indabs = abs350aer
  2239. else
  2240. write(gol,*) 'user_output_aerocom: wrong wavelength given for aerocom diagnostics' ; call goErr
  2241. TRACEBACK
  2242. status=1; return
  2243. end if
  2244. ! fill AODs
  2245. allocate(temp2d(i1:i2,j1:j2))
  2246. temp2d = 0.0
  2247. do j = j1, j2
  2248. do i = i1, i2
  2249. ! multiply with height elements and sum up
  2250. tabs = 0.0
  2251. do l = 1, lmr
  2252. temp2d(i,j) = temp2d(i,j) + opt_ext(i,j,l,lwl,1) * &
  2253. (gph_dat(region)%data(i,j,l+1) - &
  2254. gph_dat(region)%data(i,j,l ))
  2255. tabs = tabs + opt_ext(i,j,l,lwl,1) * (1.0 - opt_a(i,j,l,lwl)) * &
  2256. (gph_dat(region)%data(i,j,l+1) - gph_dat(region)%data(i,j,l))
  2257. end do
  2258. mixf(region)%f2d(indabs)%field(i,j) = &
  2259. mixf(region)%f2d(indabs)%field(i,j) + tabs * dtime
  2260. end do
  2261. end do
  2262. ! write to container
  2263. mixf(region)%f2d(indoffset)%field = &
  2264. mixf(region)%f2d(indoffset)%field + temp2d * dtime
  2265. deallocate(temp2d)
  2266. endif
  2267. ! 3-D extinction and absorption (m-1)
  2268. if ( aai_output ) then
  2269. if ( wdep_out(lwl)%wl == 0.550 .or. wdep_out(lwl)%wl == 0.350 ) then
  2270. if ( wdep_out(lwl)%wl == 0.550 ) then
  2271. indoffset = ec5503Daer
  2272. elseif ( wdep_out(lwl)%wl == 0.350 ) then
  2273. indoffset = ec3503Daer
  2274. endif
  2275. mixf(region)%f3d(indoffset)%field = &
  2276. mixf(region)%f3d(indoffset)%field + opt_ext(:,:,:,lwl,1) * dtime
  2277. mixf(region)%f3d(indoffset+1)%field = &
  2278. mixf(region)%f3d(indoffset+1)%field + opt_ext(:,:,:,lwl,1) * (1.0 - opt_a(:,:,:,lwl)) * dtime
  2279. endif
  2280. endif
  2281. if ( wdep_out(lwl)%insitu ) then
  2282. if ( wdep_out(lwl)%wl == 0.440 ) then
  2283. indoffset = ec440dryaer
  2284. indoffset_stat = ec440dryaer_stat
  2285. nadd_max=2
  2286. elseif ( wdep_out(lwl)%wl == 0.550 ) then
  2287. indoffset = ec550dryaer
  2288. indoffset_stat = ec550dryaer_stat
  2289. nadd_max=5
  2290. elseif ( wdep_out(lwl)%wl == 0.870 ) then
  2291. indoffset = ec870dryaer
  2292. indoffset_stat = ec870dryaer_stat
  2293. nadd_max=2
  2294. else
  2295. write(gol,*) 'user_output_aerocom: wrong wavelength given for aerocom diagnostics' ; call goErr
  2296. TRACEBACK
  2297. status=1; return
  2298. end if
  2299. ! Surface dry aerosol extinction & absorption
  2300. do lct = 1, nadd_max
  2301. mixf(region)%f2d(indoffset+lct-1)%field = mixf(region)%f2d(indoffset+lct-1)%field + &
  2302. opt_add(i1:i2,j1:j2,1,lwl,lct) * dtime
  2303. enddo
  2304. if (stat_output) then
  2305. ! --------------------------------------
  2306. ! stations
  2307. ! --------------------------------------
  2308. if (stat_halo_glob.eq.1) then
  2309. do lct = 1, nadd_max
  2310. CALL UPDATE_HALO( dgrid(region), opt_add(:,:,:,lwl,lct), l_halo, status)
  2311. IF_NOTOK_RETURN(status=1)
  2312. enddo
  2313. endif
  2314. do istat = 1, nstations
  2315. if (stat_active(istat)) then
  2316. do lct = 1, nadd_max
  2317. statf(region)%f1d(indoffset_stat+lct-1)%field(istat,:) = &
  2318. statf(region)%f1d(indoffset_stat+lct-1)%field(istat,:) + &
  2319. aerocom_do_interp_1d( opt_add(i1:ie,j1:je,:,lwl,lct), region, istat ) * dtime
  2320. statf(region)%f0d(indoffset_stat+lct-1)%field(istat) = &
  2321. statf(region)%f0d(indoffset_stat+lct-1)%field(istat) + &
  2322. aerocom_do_interp_0d( opt_add(i1:ie,j1:je,:,lwl,lct), region, istat ) * dtime
  2323. enddo
  2324. endif
  2325. end do
  2326. endif
  2327. endif
  2328. end do
  2329. ! done
  2330. deallocate( opt_ext, opt_a, opt_g, opt_add )
  2331. nullify(rm)
  2332. nullify(dxyp)
  2333. deallocate( pres3d )
  2334. call goLabel() ; status = 0
  2335. end subroutine output_aerocom_step
  2336. !EOC
  2337. !--------------------------------------------------------------------------
  2338. ! TM5 !
  2339. !--------------------------------------------------------------------------
  2340. !BOP
  2341. !
  2342. ! !IROUTINE: COLLECT_BUDGETS
  2343. !
  2344. ! !DESCRIPTION: This routine does book keeping of the budget values in
  2345. ! order to extract daily contributions to
  2346. ! emissions / dry deposition / wet deposition.
  2347. !\\
  2348. !\\
  2349. ! !INTERFACE:
  2350. !
  2351. subroutine collect_budgets(region, status)
  2352. !
  2353. ! !USES:
  2354. !
  2355. #ifndef without_chemistry
  2356. use ebischeme, only : buddry_dat => buddep_dat
  2357. #endif
  2358. use wet_deposition, only : buddep_dat
  2359. use emission_data, only : budemi_dat
  2360. use budget_global, only : nbud_vg
  2361. use global_data, only : region_dat
  2362. use chem_param, only : iducoi, iduacs, iducos, iduaci, isscos, issacs
  2363. use chem_param, only : ibccos, ibcaii, ibcacs, ibcais, ino3_a, xmair
  2364. use chem_param, only : iso4nus, iso4acs, iso4cos, iso4ais
  2365. use chem_param, only : ipomcos, ipomaii, ipomacs, ipomais
  2366. use chem_param, only : isoacos, isoaaii, isoaacs, isoaais, isoanus
  2367. use chem_param, only : idms, iso2, ntracet, ntrace
  2368. use chem_param, only : xmso2, xmso4, xmdms, xmpom, xmbc, xmdust, xmnacl
  2369. #ifndef without_sedimentation
  2370. use sedimentation, only : buddep_m7_dat
  2371. use sedimentation, only : nsed, ised
  2372. #endif
  2373. !
  2374. ! !INPUT PARAMETERS:
  2375. !
  2376. integer, intent(in) :: region
  2377. !
  2378. ! !OUTPUT PARAMETERS:
  2379. !
  2380. integer, intent(out) :: status
  2381. !
  2382. ! !REVISION HISTORY:
  2383. ! 29 Nov 2010 - Achim Strunk -
  2384. !
  2385. ! !REMARKS:
  2386. !
  2387. !EOP
  2388. !------------------------------------------------------------------------
  2389. !BOC
  2390. character(len=*), parameter :: rname = mname//'/collect_budgets'
  2391. real, dimension(:,:,:,:), allocatable :: collect4d
  2392. real, dimension(:,:,:), allocatable :: collect3d
  2393. real, dimension(:,:), allocatable :: tmpbud2d
  2394. real, dimension(:), pointer :: dxyp
  2395. integer :: imr, jmr, lmr, j
  2396. integer :: i1, i2, j1, j2
  2397. !>>> TvN
  2398. integer :: l, n
  2399. !<<< TvN
  2400. ! --- begin -------------------------------
  2401. call goLabel(rname)
  2402. ! grid size
  2403. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2404. imr=i2-i1+1
  2405. jmr=j2-j1+1
  2406. lmr = levi%nlev
  2407. ! this is area element
  2408. dxyp => region_dat(region)%dxyp
  2409. ! --------------
  2410. ! EMISSIONS
  2411. ! --------------
  2412. ! collect emission budget
  2413. allocate( collect4d(i1:i2,j1:j2,nbud_vg,ntracet) ); collect4d = 0.0
  2414. ! emissions are in [mole]
  2415. ! convert first to kilomole per area [k-mole/m2]
  2416. #ifndef without_emission
  2417. do j = j1, j2
  2418. collect4d(:,j,:,:) = budemi_dat(region)%emi(i1:i2,j,:,:) / dxyp(j) * 1.E-03
  2419. end do
  2420. #endif
  2421. allocate( tmpbud2d(i1:i2,j1:j2) )
  2422. ! on the way: convert from kilomole/m2 to kg/m2 via molar mass [g/mole]
  2423. ! POM (AIS + ACS + COS + AII)
  2424. tmpbud2d = ( sum(collect4d(:,:,:,iPOMais),3) + sum(collect4d(:,:,:,iPOMacs),3) + &
  2425. sum(collect4d(:,:,:,iPOMcos),3) + sum(collect4d(:,:,:,iPOMaii),3) ) * xmpom
  2426. mixf(region)%f2d(emioa)%field = tmpbud2d - emission(region)%f2dslast(:,:,1)
  2427. emission(region)%f2dslast(:,:,1) = tmpbud2d
  2428. ! BC (AIS + ACS + COS + AII)
  2429. tmpbud2d = ( sum(collect4d(:,:,:,iBCais ),3) + sum(collect4d(:,:,:,iBCacs ),3) + &
  2430. sum(collect4d(:,:,:,iBCcos ),3) + sum(collect4d(:,:,:,iBCaii ),3) ) * xmbc
  2431. mixf(region)%f2d(emibc)%field = tmpbud2d - emission(region)%f2dslast(:,:,2)
  2432. emission(region)%f2dslast(:,:,2) = tmpbud2d
  2433. ! SO2
  2434. tmpbud2d = sum(collect4d(:,:,:,iSO2 ),3) * xmso2
  2435. mixf(region)%f2d(emiso2)%field = tmpbud2d - emission(region)%f2dslast(:,:,3)
  2436. emission(region)%f2dslast(:,:,3) = tmpbud2d
  2437. ! SO4 (NUS + AIS + ACS + COS)
  2438. tmpbud2d = ( sum(collect4d(:,:,:,iSO4nus),3) + sum(collect4d(:,:,:,iSO4ais),3) + &
  2439. sum(collect4d(:,:,:,iSO4acs),3) + sum(collect4d(:,:,:,iSO4cos),3) ) * xmso4
  2440. mixf(region)%f2d(emiso4)%field = tmpbud2d - emission(region)%f2dslast(:,:,4)
  2441. emission(region)%f2dslast(:,:,4) = tmpbud2d
  2442. ! Dust (ACS + COS + ACI + COI)
  2443. tmpbud2d = ( sum(collect4d(:,:,:,iDUacs ),3) + sum(collect4d(:,:,:,iDUcos ),3) + &
  2444. sum(collect4d(:,:,:,iDUaci ),3) + sum(collect4d(:,:,:,iDUcoi ),3) ) * xmdust
  2445. mixf(region)%f2d(emidust)%field = tmpbud2d - emission(region)%f2dslast(:,:,5)
  2446. emission(region)%f2dslast(:,:,5) = tmpbud2d
  2447. ! DMS
  2448. tmpbud2d = sum(collect4d(:,:,:,iDMS ),3) * xmdms
  2449. mixf(region)%f2d(emidms)%field = tmpbud2d - emission(region)%f2dslast(:,:,6)
  2450. emission(region)%f2dslast(:,:,6) = tmpbud2d
  2451. ! Seasalt: (ACS + COS)
  2452. tmpbud2d = ( sum(collect4d(:,:,:,iSSacs ),3) + sum(collect4d(:,:,:,iSScos ),3) ) * xmnacl
  2453. mixf(region)%f2d(emiss)%field = tmpbud2d - emission(region)%f2dslast(:,:,7)
  2454. emission(region)%f2dslast(:,:,7) = tmpbud2d
  2455. deallocate( tmpbud2d )
  2456. deallocate( collect4d )
  2457. ! --------------
  2458. ! DRY DEPOSITION
  2459. ! --------------
  2460. allocate( collect3d(i1:i2,j1:j2,ntrace) ); collect3d = 0.0
  2461. ! deposition is in [mole]
  2462. ! convert first to kilomole per area [k-mole/m2]
  2463. do j = j1, j2
  2464. #ifndef without_chemistry
  2465. collect3d(:,j,:) = buddry_dat(region)%dry(i1:i2,j,:) / dxyp(j) * 1.E-3
  2466. #endif
  2467. ! Add sedimentation at the surface to dry depostion
  2468. ! Sedimentation budgets have to be summed in the vertical
  2469. ! to get the surface contribution.
  2470. #ifndef without_sedimentation
  2471. do l = 1, nbud_vg
  2472. do n = 1, nsed
  2473. collect3d(:,j,ised(n)) = collect3d(:,j,ised(n)) + &
  2474. buddep_m7_dat(region)%sed(i1:i2,j,l,n) / dxyp(j) * 1.E-3
  2475. end do
  2476. end do
  2477. #endif
  2478. end do
  2479. allocate( tmpbud2d(i1:i2,j1:j2) )
  2480. ! on the way: convert from kilomole/m2 to kg/m2 via molar mass [g/mole]
  2481. ! SO2
  2482. tmpbud2d = collect3d(:,:,iSO2) * xmso2
  2483. mixf(region)%f2d(dryso2)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,1)
  2484. drydepos(region)%f2dslast(:,:,1) = tmpbud2d
  2485. ! POM (AIS + ACS + COS + AII)
  2486. tmpbud2d = ( collect3d(:,:,iPOMais ) + collect3d(:,:,iPOMacs ) + &
  2487. collect3d(:,:,iPOMcos ) + collect3d(:,:,iPOMaii ) ) * xmpom
  2488. mixf(region)%f2d(dryoa)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,2)
  2489. drydepos(region)%f2dslast(:,:,2) = tmpbud2d
  2490. ! SOA (NUS + AIS + ACS + COS + AII)
  2491. tmpbud2d = ( collect3d(:,:,iSOAais ) + collect3d(:,:,iSOAacs ) + &
  2492. collect3d(:,:,iSOAcos ) + collect3d(:,:,iSOAaii ) + &
  2493. collect3d(:,:,iSOAnus )) * xmpom
  2494. mixf(region)%f2d(drysoa)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,8)
  2495. drydepos(region)%f2dslast(:,:,8) = tmpbud2d
  2496. ! BC (AIS + ACS + COS + AII)
  2497. tmpbud2d = ( collect3d(:,:,iBCais ) + collect3d(:,:,iBCacs ) + &
  2498. collect3d(:,:,iBCcos ) + collect3d(:,:,iBCaii ) ) * xmbc
  2499. mixf(region)%f2d(drybc)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,3)
  2500. drydepos(region)%f2dslast(:,:,3) = tmpbud2d
  2501. ! SO4 (NUS + AIS + ACS + COS)
  2502. tmpbud2d = ( collect3d(:,:,iSO4nus) + collect3d(:,:,iSO4ais) + &
  2503. collect3d(:,:,iSO4acs) + collect3d(:,:,iSO4cos) ) * xmso4
  2504. mixf(region)%f2d(dryso4)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,4)
  2505. drydepos(region)%f2dslast(:,:,4) = tmpbud2d
  2506. ! Dust (ACS + COS + ACI + COI)
  2507. tmpbud2d = ( collect3d(:,:,iDUacs) + collect3d(:,:,iDUcos) + &
  2508. collect3d(:,:,iDUaci) + collect3d(:,:,iDUcoi) ) * xmdust
  2509. mixf(region)%f2d(drydust)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,5)
  2510. drydepos(region)%f2dslast(:,:,5) = tmpbud2d
  2511. ! DMS
  2512. ! DMS is NOT deposited in TM5 --> the fields will contain zeros
  2513. tmpbud2d = collect3d(:,:,iDMS) * xmdms
  2514. mixf(region)%f2d(drydms)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,6)
  2515. drydepos(region)%f2dslast(:,:,6) = tmpbud2d
  2516. ! Seasalt: (ACS + COS)
  2517. tmpbud2d = ( collect3d(:,:,iSSacs) + collect3d(:,:,iSScos) ) * xmnacl
  2518. mixf(region)%f2d(dryss)%field = tmpbud2d - drydepos(region)%f2dslast(:,:,7)
  2519. drydepos(region)%f2dslast(:,:,7) = tmpbud2d
  2520. deallocate( tmpbud2d )
  2521. deallocate( collect3d )
  2522. ! --------------
  2523. ! WET DEPOSITION
  2524. ! --------------
  2525. allocate( collect4d (i1:i2,j1:j2,nbud_vg,ntracet) ); collect4d = 0.0
  2526. ! deposition is in [mole]
  2527. ! convert first to kilomole per area [k-mole/m2]
  2528. do j = j1, j2
  2529. collect4d(:,j,:,:) = ( buddep_dat(region)%lsp(i1:i2,j,:,:) + buddep_dat(region)%cp(i1:i2,j,:,:) ) / dxyp(j) * 1.E-3
  2530. end do
  2531. allocate( tmpbud2d(i1:i2,j1:j2) )
  2532. ! on the way: convert from kilomole/m2 to kg/m2 via molar mass [g/mole]
  2533. ! POM (AIS + ACS + COS + AII)
  2534. tmpbud2d = ( sum(collect4d(:,:,:,iPOMais),3) + sum(collect4d(:,:,:,iPOMacs),3) + &
  2535. sum(collect4d(:,:,:,iPOMcos),3) + sum(collect4d(:,:,:,iPOMaii),3) ) * xmpom
  2536. mixf(region)%f2d(wetoa)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,1)
  2537. wetdepos(region)%f2dslast(:,:,1) = tmpbud2d
  2538. ! SOA (NUS + AIS + ACS + COS + AII)
  2539. tmpbud2d = ( sum(collect4d(:,:,:,iSOAais),3) + sum(collect4d(:,:,:,iSOAacs),3) + &
  2540. sum(collect4d(:,:,:,iSOAcos),3) + sum(collect4d(:,:,:,iSOAaii),3) + &
  2541. sum(collect4d(:,:,:,iSOAnus),3)) * xmpom
  2542. mixf(region)%f2d(wetsoa)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,8)
  2543. wetdepos(region)%f2dslast(:,:,8) = tmpbud2d
  2544. ! BC (AIS + ACS + COS + AII)
  2545. tmpbud2d = ( sum(collect4d(:,:,:,iBCais ),3) + sum(collect4d(:,:,:,iBCacs ),3) + &
  2546. sum(collect4d(:,:,:,iBCcos ),3) + sum(collect4d(:,:,:,iBCaii ),3) ) * xmbc
  2547. mixf(region)%f2d(wetbc)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,2)
  2548. wetdepos(region)%f2dslast(:,:,2) = tmpbud2d
  2549. ! SO2
  2550. tmpbud2d = sum(collect4d(:,:,:,iSO2 ),3) * xmso2
  2551. mixf(region)%f2d(wetso2)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,3)
  2552. wetdepos(region)%f2dslast(:,:,3) = tmpbud2d
  2553. ! SO4 (NUS + AIS + ACS + COS)
  2554. tmpbud2d = ( sum(collect4d(:,:,:,iSO4nus),3) + sum(collect4d(:,:,:,iSO4ais),3) + &
  2555. sum(collect4d(:,:,:,iSO4acs),3) + sum(collect4d(:,:,:,iSO4cos),3) ) * xmso4
  2556. mixf(region)%f2d(wetso4)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,4)
  2557. wetdepos(region)%f2dslast(:,:,4) = tmpbud2d
  2558. ! Dust (ACS + COS + ACI + COI)
  2559. tmpbud2d = ( sum(collect4d(:,:,:,iDUacs ),3) + sum(collect4d(:,:,:,iDUcos ),3) + &
  2560. sum(collect4d(:,:,:,iDUaci ),3) + sum(collect4d(:,:,:,iDUcoi ),3) ) * xmdust
  2561. mixf(region)%f2d(wetdust)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,5)
  2562. wetdepos(region)%f2dslast(:,:,5) = tmpbud2d
  2563. ! DMS
  2564. ! DMS is NOT deposited in TM5 --> the fields will contain zeros
  2565. tmpbud2d = sum(collect4d(:,:,:,iDMS ),3) * xmdms
  2566. mixf(region)%f2d(wetdms)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,6)
  2567. wetdepos(region)%f2dslast(:,:,6) = tmpbud2d
  2568. ! Seasalt: (ACS + COS)
  2569. tmpbud2d = ( sum(collect4d(:,:,:,iSSacs ),3) + sum(collect4d(:,:,:,iSScos ),3) ) * xmnacl
  2570. mixf(region)%f2d(wetss)%field = tmpbud2d - wetdepos(region)%f2dslast(:,:,7)
  2571. wetdepos(region)%f2dslast(:,:,7) = tmpbud2d
  2572. deallocate( tmpbud2d )
  2573. deallocate( collect4d )
  2574. nullify(dxyp)
  2575. call goLabel() ; status = 0
  2576. end subroutine collect_budgets
  2577. !EOC
  2578. !--------------------------------------------------------------------------
  2579. ! TM5 !
  2580. !--------------------------------------------------------------------------
  2581. !BOP
  2582. !
  2583. ! !IROUTINE: AEROCOM_GET_STATINTP
  2584. !
  2585. ! !DESCRIPTION: This routine provides interpolation coefficients to
  2586. ! (yet another) interpolation routine for the stations.
  2587. ! The interpolation routine is below ( aerocom_do_interp ).
  2588. !\\
  2589. ! !INTERFACE:
  2590. !
  2591. subroutine aerocom_get_statintp( region, status )
  2592. !
  2593. ! !USES:
  2594. !
  2595. use dims, only : dy, dx, yref, xref, xbeg, xend, ybeg, yend, xcyc
  2596. use dims, only : im, jm, lm
  2597. use Meteodata, only : gph_dat
  2598. use partools, only : par_reduce
  2599. !
  2600. ! !INPUT PARAMETERS:
  2601. !
  2602. integer, intent(in) :: region
  2603. !
  2604. ! !OUTPUT PARAMETERS:
  2605. !
  2606. integer, intent(out) :: status
  2607. !
  2608. ! !REVISION HISTORY:
  2609. ! 29 Nov 2010 - Achim Strunk - Creation
  2610. !
  2611. ! !REMARKS:
  2612. !
  2613. !EOP
  2614. !------------------------------------------------------------------------
  2615. !BOC
  2616. character(len=*), parameter :: rname = mname//'/aerocom_get_statintp'
  2617. real :: rt, sheight, dxr, dyr
  2618. real, dimension(0:lm(region)) :: gheight
  2619. integer :: i, l
  2620. integer :: i1, i2, j1, j2
  2621. ! --- begin -------------------------------
  2622. call goLabel(rname)
  2623. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2624. dyr = dy/yref(region)
  2625. dxr = dx/xref(region)
  2626. do i = 1, nstations
  2627. ! i-coordinates and weights
  2628. rt = (statlist(i)%statlon - float(xbeg(region)))/dxr + 0.5
  2629. sintp(region)%ixl(i) = int(rt)
  2630. sintp(region)%wixr(i) = rt - sintp(region)%ixl(i)
  2631. sintp(region)%wixl(i) = 1.0 - sintp(region)%wixr(i)
  2632. if ( sintp(region)%ixl(i) == 0 ) then
  2633. sintp(region)%ixl(i) = im(region)
  2634. endif
  2635. sintp(region)%ixr(i) = sintp(region)%ixl(i) + 1
  2636. ! j-coordinates and weights
  2637. rt = (statlist(i)%statlat - float(ybeg(region)))/dyr + 0.5
  2638. sintp(region)%jyl(i) = int(rt)
  2639. sintp(region)%jyr(i) = sintp(region)%jyl(i) + 1
  2640. sintp(region)%wjyr(i) = rt - sintp(region)%jyl(i)
  2641. sintp(region)%wjyl(i) = 1.0 - sintp(region)%wjyr(i)
  2642. if ( sintp(region)%jyl(i) == 0 ) sintp(region)%jyl(i) = 1
  2643. if ( sintp(region)%jyr(i) == jm(region)+1 ) sintp(region)%jyr(i) = jm(region)
  2644. ! check if left/lower cell of interpolation calculation is in the processor domain
  2645. ! ensures that each station is handled by a single processor
  2646. if ( (sintp(region)%ixl(i).ge.i1).and.(sintp(region)%ixl(i).le.i2).and. &
  2647. (sintp(region)%jyl(i).ge.j1).and.(sintp(region)%jyl(i).le.j2) ) then
  2648. stat_active(i)=.true.
  2649. if ( (sintp(region)%ixr(i).eq.i2+1).or.(sintp(region)%jyr(i).eq.j2+1) ) then
  2650. stat_halo_loc=1
  2651. endif
  2652. endif
  2653. enddo
  2654. call PAR_REDUCE( stat_halo_loc, 'max', stat_halo_glob, status, all=.true.)
  2655. if (stat_halo_glob.eq.1) then
  2656. CALL UPDATE_HALO( dgrid(region), gph_dat(region)%data, gph_dat(region)%halo, status)
  2657. IF_NOTOK_RETURN(status=1)
  2658. endif
  2659. do i = 1, nstations
  2660. if ( stat_active(i) ) then
  2661. ! --------
  2662. ! interpolate gph to station, use half level (center of box) & surface
  2663. ! gph is from 1 -> lm(region)+1
  2664. ! --------
  2665. gheight(0) = sintp(region)%wixl(i) * sintp(region)%wjyl(i) * gph_dat(region)%data(sintp(region)%ixl(i),sintp(region)%jyl(i),1) + &
  2666. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * gph_dat(region)%data(sintp(region)%ixr(i),sintp(region)%jyl(i),1) + &
  2667. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * gph_dat(region)%data(sintp(region)%ixr(i),sintp(region)%jyr(i),1) + &
  2668. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * gph_dat(region)%data(sintp(region)%ixl(i),sintp(region)%jyr(i),1)
  2669. do l = 1, lm(region)
  2670. gheight(l) = sintp(region)%wixl(i) * sintp(region)%wjyl(i) * sum(gph_dat(region)%data(sintp(region)%ixl(i),sintp(region)%jyl(i),l:l+1))/2. + &
  2671. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * sum(gph_dat(region)%data(sintp(region)%ixr(i),sintp(region)%jyl(i),l:l+1))/2. + &
  2672. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * sum(gph_dat(region)%data(sintp(region)%ixr(i),sintp(region)%jyr(i),l:l+1))/2. + &
  2673. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * sum(gph_dat(region)%data(sintp(region)%ixl(i),sintp(region)%jyr(i),l:l+1))/2.
  2674. end do
  2675. sintp(region)%tght(i) = gheight(0)
  2676. ! --------
  2677. ! determine layer of station
  2678. ! --------
  2679. ! copy temporary the height of station
  2680. sheight = statlist(i)%statalt
  2681. ! do not allow sampleheight below model surface
  2682. ! -> force station height to model surface
  2683. sheight = max(sheight, gheight(0))
  2684. do l = 1, lm(region)
  2685. if( gheight(l) > sheight ) exit
  2686. end do
  2687. ! success??
  2688. if( l > lm(region) ) then
  2689. ! not successful, station higher than model (strange!!!)
  2690. write(gol,'("Error in retrieving vertical layer of station")'); call goErr
  2691. TRACEBACK
  2692. status=1
  2693. return
  2694. endif
  2695. ! restrict lower index to surface
  2696. sintp(region)%lzl(i) = max(l-1,1)
  2697. sintp(region)%lzr(i) = l
  2698. sintp(region)%wlzl(i) = (gheight(l) - sheight) / (gheight(l) - gheight(l-1))
  2699. sintp(region)%wlzr(i) = 1.0 - sintp(region)%wlzl(i)
  2700. endif
  2701. end do
  2702. call goLabel() ; status = 0
  2703. end subroutine aerocom_get_statintp
  2704. !EOC
  2705. !--------------------------------------------------------------------------
  2706. ! TM5 !
  2707. !--------------------------------------------------------------------------
  2708. !BOP
  2709. !
  2710. ! !FUNCTION: AEROCOM_DO_INTERP_1D
  2711. !
  2712. ! !DESCRIPTION: Interpolation of a given 3d field, using module wide
  2713. ! interpolation coeffients and indices for stations (sintp).
  2714. !\\
  2715. !\\
  2716. ! !INTERFACE:
  2717. !
  2718. function aerocom_do_interp_1d( f3d, region, istat )
  2719. !
  2720. ! !INPUT PARAMETERS:
  2721. !
  2722. real, dimension(:,:,:), intent(in) :: f3d
  2723. integer, intent(in) :: region
  2724. integer, intent(in) :: istat
  2725. !
  2726. ! !RETURN VALUE:
  2727. !
  2728. real,dimension (levi%nlev) :: aerocom_do_interp_1d
  2729. !
  2730. ! !REVISION HISTORY:
  2731. ! 6 Feb 2011 - Achim Strunk -
  2732. !
  2733. ! !REMARKS:
  2734. !
  2735. !EOP
  2736. !------------------------------------------------------------------------
  2737. !BOC
  2738. character(len=*), parameter :: rname = mname//'/aerocom_do_interp_1d'
  2739. integer :: i
  2740. integer :: i1, i2, j1, j2
  2741. integer :: il,ir,jl,jr
  2742. ! --- begin -------------------------------
  2743. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2744. i = istat
  2745. ! shift index in the input array
  2746. il=sintp(region)%ixl(i) - i1 + 1
  2747. ir=sintp(region)%ixr(i) - i1 + 1
  2748. jl=sintp(region)%jyl(i) - j1 + 1
  2749. jr=sintp(region)%jyr(i) - j1 + 1
  2750. ! ordering
  2751. ! i = llllrrrr, j = llrrllrr
  2752. aerocom_do_interp_1d(:) = &
  2753. sintp(region)%wixl(i) * sintp(region)%wjyl(i) * f3d(il,jl,:) + &
  2754. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * f3d(il,jr,:) + &
  2755. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * f3d(ir,jl,:) + &
  2756. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * f3d(ir,jr,:)
  2757. return
  2758. end function aerocom_do_interp_1d
  2759. !EOC
  2760. !--------------------------------------------------------------------------
  2761. ! TM5 !
  2762. !--------------------------------------------------------------------------
  2763. !BOP
  2764. !
  2765. ! !FUNCTION: AEROCOM_DO_INTERP_0D
  2766. !
  2767. ! !DESCRIPTION: Interpolation of a given 3d field, using module wide
  2768. ! interpolation coeffients and indices for stations (sintp).
  2769. !\\
  2770. !\\
  2771. ! !INTERFACE:
  2772. !
  2773. function aerocom_do_interp_0d( f3d, region, istat )
  2774. !
  2775. ! !INPUT PARAMETERS:
  2776. !
  2777. real, dimension(:,:,:), intent(in) :: f3d
  2778. integer, intent(in) :: region
  2779. integer, intent(in) :: istat
  2780. !
  2781. ! !RETURN VALUE:
  2782. !
  2783. real :: aerocom_do_interp_0d
  2784. !
  2785. ! !REVISION HISTORY:
  2786. ! 6 Feb 2011 - Achim Strunk -
  2787. !
  2788. ! !REMARKS:
  2789. !
  2790. !EOP
  2791. !------------------------------------------------------------------------
  2792. !BOC
  2793. character(len=*), parameter :: rname = mname//'/aerocom_do_interp_0d'
  2794. integer :: i
  2795. integer :: i1, i2, j1, j2
  2796. integer :: il,ir,jl,jr
  2797. ! --- begin -------------------------------
  2798. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2799. i = istat
  2800. ! shift index in the input array
  2801. il=sintp(region)%ixl(i) - i1 + 1
  2802. ir=sintp(region)%ixr(i) - i1 + 1
  2803. jl=sintp(region)%jyl(i) - j1 + 1
  2804. jr=sintp(region)%jyr(i) - j1 + 1
  2805. ! ordering
  2806. ! i = llllrrrr, j = llrrllrr, l = lrlrlrlr
  2807. aerocom_do_interp_0d = &
  2808. sintp(region)%wixl(i) * sintp(region)%wjyl(i) * sintp(region)%wlzl(i) * f3d(il,jl,sintp(region)%lzl(i)) + &
  2809. sintp(region)%wixl(i) * sintp(region)%wjyl(i) * sintp(region)%wlzr(i) * f3d(il,jl,sintp(region)%lzr(i)) + &
  2810. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * sintp(region)%wlzl(i) * f3d(il,jr,sintp(region)%lzl(i)) + &
  2811. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * sintp(region)%wlzr(i) * f3d(il,jr,sintp(region)%lzr(i)) + &
  2812. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * sintp(region)%wlzl(i) * f3d(ir,jl,sintp(region)%lzl(i)) + &
  2813. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * sintp(region)%wlzr(i) * f3d(ir,jl,sintp(region)%lzr(i)) + &
  2814. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * sintp(region)%wlzl(i) * f3d(ir,jr,sintp(region)%lzl(i)) + &
  2815. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * sintp(region)%wlzr(i) * f3d(ir,jr,sintp(region)%lzr(i))
  2816. return
  2817. end function aerocom_do_interp_0d
  2818. !EOC
  2819. !--------------------------------------------------------------------------
  2820. ! TM5 !
  2821. !--------------------------------------------------------------------------
  2822. !BOP
  2823. !
  2824. ! !FUNCTION: AEROCOM_DO_INTERP_SURF
  2825. !
  2826. ! !DESCRIPTION: Interpolation of a given surface field, using module wide
  2827. ! interpolation coeffients and indices for stations (sintp).
  2828. !\\
  2829. !\\
  2830. ! !INTERFACE:
  2831. !
  2832. function aerocom_do_interp_surf( f2d, region, istat )
  2833. !
  2834. ! !INPUT PARAMETERS:
  2835. !
  2836. real, dimension(:,:), intent(in) :: f2d
  2837. integer, intent(in) :: region
  2838. integer, intent(in) :: istat
  2839. !
  2840. ! !RETURN VALUE:
  2841. !
  2842. real :: aerocom_do_interp_surf
  2843. !
  2844. ! !REVISION HISTORY:
  2845. ! 6 Feb 2011 - Achim Strunk -
  2846. !
  2847. ! !REMARKS:
  2848. !
  2849. !EOP
  2850. !------------------------------------------------------------------------
  2851. !BOC
  2852. character(len=*), parameter :: rname = mname//'/aerocom_do_interp_surf'
  2853. integer :: i
  2854. integer :: i1, i2, j1, j2
  2855. integer :: il,ir,jl,jr
  2856. ! --- begin -------------------------------
  2857. call Get_DistGrid( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  2858. i = istat
  2859. ! shift index in the input array
  2860. il=sintp(region)%ixl(i) - i1 + 1
  2861. ir=sintp(region)%ixr(i) - i1 + 1
  2862. jl=sintp(region)%jyl(i) - j1 + 1
  2863. jr=sintp(region)%jyr(i) - j1 + 1
  2864. ! ordering
  2865. ! i = llllrrrr, j = llrrllrr
  2866. aerocom_do_interp_surf = &
  2867. sintp(region)%wixl(i) * sintp(region)%wjyl(i) * f2d(il,jl) + &
  2868. sintp(region)%wixl(i) * sintp(region)%wjyr(i) * f2d(il,jr) + &
  2869. sintp(region)%wixr(i) * sintp(region)%wjyl(i) * f2d(ir,jl) + &
  2870. sintp(region)%wixr(i) * sintp(region)%wjyr(i) * f2d(ir,jr)
  2871. return
  2872. end function aerocom_do_interp_surf
  2873. !EOC
  2874. end module user_output_aerocom