emission_read__co2.F90 62 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760
  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. !
  5. #include "tm5.inc"
  6. !
  7. !-----------------------------------------------------------------------------
  8. ! TM5 !
  9. !-----------------------------------------------------------------------------
  10. !BOP
  11. !
  12. ! !MODULE: EMISSION_READ
  13. !
  14. ! !DESCRIPTION: This module provides objects and methods related to
  15. ! CMIP6 and IPCC-AR5 emissions.
  16. !
  17. ! AR5 netCDF files are provided by CMIP5:
  18. !
  19. ! There are a few keys in the rc-file which control the behaviour of
  20. ! this module and the data used:
  21. ! # specify the (main) provider of emission sets
  22. ! input.emis.provider : AR5
  23. ! # where to find the emissions (this will be used by install-emis-ar5)
  24. ! input.emis.dir : ${TEMP}/EMIS/AR5
  25. ! # year of emissions (AR5 emissions will be linearly interpolated)
  26. ! input.emis.year : 2000
  27. ! # choose RCP out of RCP26, RCP45, RCP60, RCP85
  28. ! input.emis.AR5.RCP : RCP45
  29. !
  30. !\\
  31. !\\
  32. ! !INTERFACE:
  33. !
  34. MODULE EMISSION_READ
  35. !
  36. ! !USES:
  37. !
  38. use GO, only : gol, goErr, goPr, goLabel
  39. use emission_data, only : emis_input_dir_cmip6
  40. use emission_data, only : emis_input_dir_ar5
  41. use emission_data, only : vd_class_name_len
  42. use dims, only : nlon360, nlat180, iglbsfc
  43. use chem_param, only : xmc, xmco2
  44. use Dims, only : okdebug
  45. USE MDF, ONLY : MDF_Open, MDF_NETCDF, MDF_READ
  46. USE MDF, ONLY : MDF_Inq_VarID, MDF_Get_Var, MDF_Close
  47. implicit none
  48. private
  49. !
  50. ! !PUBLIC MEMBER FUNCTIONS:
  51. !
  52. public :: emission_read_init, emission_read_done
  53. public :: emission_ar5_regrid_aircraft
  54. !public :: numb_2dsec, numb_3dsec
  55. public :: numb_sectors, sectors_def
  56. public :: numb_providers, providers_def
  57. public :: sector_name_len
  58. public :: emission_cmip6_readsector
  59. public :: emission_ar5_readCO2
  60. public :: ar5_dim_3ddata
  61. public :: sector_type, provider_type
  62. !
  63. ! !PRIVATE DATA MEMBERS:
  64. !
  65. character(len=*), parameter :: mname = 'emission_read'
  66. ! ------------------------------
  67. ! global characteristics
  68. ! ------------------------------
  69. ! AR5: CO2 emissions from land use are provided at 0.5x0.5, from fossil fuel use at 1x1
  70. integer, parameter :: nlat360 = 360 ! number of latitudes for CMIP6, AR5 (0.5deg)
  71. integer, parameter :: nlon720 = 720 ! number of longitudes for CMIP6, AR5 (0.5deg)
  72. integer, parameter :: sector_name_len = 18 ! length of sector descriptor
  73. integer, parameter :: categ_name_len = 14 ! length of category descriptor
  74. integer, parameter :: numb_sectors = 11 ! number of sectors (All providers!)
  75. !integer, parameter :: numb_2dsec = 10 ! number of 2d sectors (all except aircraft)
  76. !integer, parameter :: numb_3dsec = 1 ! number of 3d sectors (aircraft)
  77. integer, parameter :: numb_providers = 2 ! CMIP6, AR5
  78. ! Since CMIP6 emissions from aviation are provided on the same vertical grid
  79. ! as for AR5, this variable is also used for CMIP6:
  80. integer, parameter :: ar5_dim_3ddata = 25 ! number of layers for aircraft data
  81. ! full list of providers
  82. character(10), dimension(numb_providers), parameter :: all_providers = &
  83. & (/ 'CMIP6 ', 'AR5 '/)
  84. ! Once CO2 will be combined with chemical tracers in one model,
  85. ! a separate category for AR5 CO2 could be introduced, because the file format is different
  86. ! The above is an old comment; the code is not working for AR5 CO2 emissions
  87. ! List of providers effectively used
  88. character(10), PUBLIC, allocatable :: used_providers(:) ! CO2
  89. ! flag for degenerated cases
  90. logical, PUBLIC :: has_emis = .true.
  91. ! ------------------------------
  92. character(len=15), parameter :: filestr_common_pre = 'IPCC_emissions'
  93. character(len=25), parameter :: filestr_common_post = '0.5x0.5.nc'
  94. ! ------------------------------
  95. ! identifier of RCPs (RCP26, RCP45,...)
  96. ! ------------------------------
  97. character(len=5) :: filestr_rcpiden
  98. !------------------------------
  99. ! SSP scenario name
  100. !------------------------------
  101. character(len=14) :: ssp_name
  102. ! ------------------------------
  103. ! available years and related parameters/variables
  104. ! ------------------------------
  105. !
  106. ! CMIP6
  107. ! availability (min, max years) - Limit MACC and MEGAN to one year for EC-Earth
  108. integer, dimension(2), parameter :: cmip6_avail = (/1850, 2100/)
  109. !---------------------------------------------
  110. ! CMIP5 CO2 emission data
  111. !---------------------------------------------
  112. ! historical data
  113. !---------------------------------------------
  114. ! emissions from fossil-fuel use are provided as monthly gridded fields for 1751-2007 (1x1 degree)
  115. ! (http://dods.ipsl.jussieu.fr/cpipsl/ANDRES/)
  116. ! emissions from land use are provided as yearly gridded fields for 1850-2005 (0.5x0.5 degree)
  117. ! (http://www.mpimet.mpg.de/en/wissenschaft/land-im-erdsystem/...
  118. ! .../wechselwirkung-klima-biogeosphaere/landcover-change-emission-data.html)
  119. ! we only use the data for the years 1850-2005:
  120. integer, dimension(2), parameter :: ar5_avail = (/1850, 2005/)
  121. ! global totals (Pg C/yr) are provided as well:
  122. ! the numbers for the reference year 2005 are:
  123. !real, parameter :: co2_ff_ref = 7.6137 ! Pg C/yr as provided
  124. real, parameter :: co2_ff_ref = 7.617692 ! Pg C/yr as calculated from the gridded fields
  125. !real, parameter :: co2_lu_ref = 1.196 ! Pg C/yr as provided
  126. real, parameter :: co2_lu_ref = 1.4673 ! Pg C/yr as calculated from the gridded field
  127. ! for the land-use emissions up to 2001 the totals calculated from the gridded fields agree well
  128. ! with the totals given by the data provider
  129. ! however, for the last four years 2002-2005 the gridded fields give substantially higher totals
  130. ! this suggests that the emission totals provided for land use have been harmonized with the RCPs
  131. ! while the gridded fields have not
  132. real :: co2_ref
  133. ! future CO2 emissions for the RCPs (2006-2100) are provided as yearly totals (Pg C/yr)
  134. ! we currently use the global totals, but regional totals are available as well
  135. ! values obtained from the IIASA RCP website (http://tntcat.iiasa.ac.at/RcpDb/)
  136. ! for 2006-2100 we combined these totals with the spatial distribution for 2005
  137. integer, parameter :: ar5_nr_avail_yrs = 11
  138. integer, dimension(ar5_nr_avail_yrs), parameter :: &
  139. ar5_avail_yrs = (/ 2005, 2010, 2020, 2030, 2040, &
  140. 2050, 2060, 2070, 2080, 2090, 2100 /)
  141. real, dimension(ar5_nr_avail_yrs), parameter :: &
  142. co2ff_rcp26 = (/ 7.971, 8.821, 9.288, 7.157, 4.535, 3.186, 1.419, 0.116, -0.433, -0.870, -0.931/), &
  143. co2ff_rcp60 = (/ 7.971, 8.512, 8.950, 9.995, 11.554, 13.044, 14.824, 16.506, 17.281, 14.313, 13.753/), &
  144. co2ff_rcp45 = (/ 7.971, 8.607, 9.872, 10.953, 11.338, 11.031, 9.401, 7.118, 4.182, 4.193, 4.203/), &
  145. co2ff_rcp85 = (/ 7.971, 8.926, 11.538, 13.839, 16.787, 20.205, 23.596, 25.962, 27.406, 28.337, 28.740/), &
  146. ! for 2000 and 2005 the global total fossil-fuel emissions for the RCPs
  147. ! are 2.7% resp. 5% higher than the totals given by the provider of the historical dataset
  148. ! this suggests that this dataset has not been harmonized with the RCPs
  149. co2lu_rcp26 = (/ 1.196, 1.056, 0.973, 0.789, 0.489, 0.201, 0.615, 0.538, 0.550, 0.602, 0.511/), &
  150. co2lu_rcp60 = (/ 1.196, 0.877, 0.406, -0.557, -0.714, -0.464, -0.258, -0.029, 0.244, 0.242, 0.181/), &
  151. co2lu_rcp45 = (/ 1.196, 0.911, 0.341, 0.216, 0.199, 0.249, 0.184, 0.104, 0.008, 0.027, 0.046/), &
  152. co2lu_rcp85 = (/ 1.196, 1.044, 0.906, 0.715, 0.645, 0.576, 0.501, 0.412, 0.309, 0.194, 0.077/)
  153. real, dimension(ar5_nr_avail_yrs) :: co2_rcp
  154. logical, dimension(:), allocatable :: ltimeind
  155. character(len=7) :: ar5ff_coverage = 'monthly'
  156. character(len=7) :: ar5lu_coverage = 'yearly '
  157. ! ------------------------------
  158. ! gridbox area (to be read only once per proc)
  159. ! ------------------------------
  160. character(len=25),parameter :: cmip6_filestr_gridboxarea = 'gridbox_area.nc '
  161. character(len=25),parameter :: ar5_filestr_gridboxarea = 'gridbox_area.nc'
  162. logical, save :: area_found_05
  163. real, dimension(:,:), allocatable :: gridbox_area_05 ! gridbox area on 0.5x0.5 deg - used for AR5
  164. ! -----------------------
  165. ! data type for sectors
  166. ! -----------------------
  167. type sector_type
  168. sequence
  169. character(len=sector_name_len) :: name ! name of sector
  170. character(len=categ_name_len) :: catname ! name of category to be found in
  171. logical :: f3d ! 3d-data y/n
  172. character(len=vd_class_name_len) :: vdisttype ! vertical distribution type (equal to "classes" still to be defined)
  173. character(len=8) :: prov ! provider of information (AR5)
  174. character(len=26), dimension(:), pointer :: species ! list of species available for that sector (use for AR5 only)
  175. end type sector_type
  176. type provider_type
  177. character(len=8) :: name
  178. integer :: nsect2d, nsect3d
  179. end type provider_type
  180. type(sector_type), dimension(numb_sectors) :: sectors_def
  181. type(provider_type), dimension(numb_providers) :: providers_def
  182. !
  183. ! !REVISION HISTORY:
  184. ! 1 Oct 2010 - Achim Strunk - v0 for AR5
  185. ! 19 Jun 2012 - P. Le Sager - cosmetic for lon-lat MPI domain decomposition
  186. ! (all reading/regridding on root for now)
  187. ! 20 Nov 2012 - Ph. Le Sager - defined and build lists of used providers
  188. ! - deal with inventories years availability
  189. ! - switch to MDF interface to read data
  190. !
  191. ! !TODO:
  192. ! - should be renamed something like "emission_inventories" or "emiss_providers"
  193. ! - and need to get a **SEPARATE** module for each inventories, before it
  194. ! becomes unmanageable again
  195. !
  196. !EOP
  197. !------------------------------------------------------------------------
  198. CONTAINS
  199. !--------------------------------------------------------------------------
  200. ! TM5 !
  201. !--------------------------------------------------------------------------
  202. !BOP
  203. !
  204. ! !IROUTINE: EMISSION_READ_INIT
  205. !
  206. ! !DESCRIPTION: Initialise reading related parameters and
  207. ! allocate needed arrays
  208. !
  209. !\\
  210. ! !INTERFACE:
  211. !
  212. SUBROUTINE EMISSION_READ_INIT( rcF, status )
  213. !
  214. ! !USES:
  215. !
  216. use GO, only : TrcFile, ReadRc
  217. use partools, only : isRoot
  218. use emission_data, only : LCMIP6
  219. use emission_data, only : LAR5
  220. use meteodata, only : set, gph_dat
  221. use dims, only : im, jm, lm, nregions
  222. !
  223. ! !INPUT PARAMETERS:
  224. !
  225. type(TrcFile) :: rcF
  226. !
  227. ! !OUTPUT PARAMETERS:
  228. !
  229. integer, intent(out) :: status
  230. !
  231. ! !REVISION HISTORY:
  232. ! 1 Oct 2010 - Achim Strunk - v0 for AR5
  233. ! 20 Nov 2012 - Ph. Le Sager - build lists of used providers
  234. !
  235. ! !REMARKS:
  236. !
  237. !EOP
  238. !------------------------------------------------------------------------
  239. !BOC
  240. character(len=*), parameter :: rname=mname//'/emission_read_init'
  241. integer :: isect, iprov, nused, region
  242. logical :: mask(numb_providers)
  243. ! --- begin --------------------------------------
  244. if (LCMIP6) then
  245. ! The SSP scenario data are provided for the years 2015-2100.
  246. ! SSP5-8.5 is the only scenario run in C4MIP and is therefore set as the default here
  247. call ReadRc( rcF, 'input.CMIP6.SSP', ssp_name, status, default = 'SSP5-8.5' )
  248. IF_ERROR_RETURN(status=1)
  249. write(gol,'("SSP CMIP6 future scenario for emissions: ",a)') trim(ssp_name); call goPr
  250. else if (LAR5) then
  251. call ReadRc( rcF, 'input.emis.AR5.RCP', filestr_rcpiden, status, default='RCP26' )
  252. IF_ERROR_RETURN(status=1)
  253. endif
  254. ! ------------------
  255. ! build list of used providers
  256. ! ------------------
  257. ! CO2
  258. mask = (/ LCMIP6, LAR5 /)
  259. nused = count(mask)
  260. if (nused /= 0) then
  261. allocate( used_providers(nused) )
  262. used_providers = pack( all_providers, mask)
  263. else
  264. has_emis = .false.
  265. end if
  266. ! info
  267. if ( has_emis ) then
  268. write(gol,*) 'EMISS-INFO - Emissions providers used for CO2: ', used_providers ; call goPr
  269. else
  270. write(gol,*) 'EMISS-INFO - Emissions providers used for CO2: NONE' ; call goPr
  271. end if
  272. ! ------------------
  273. ! initialise sectors
  274. ! ------------------
  275. ! Type sequence is (name, category, is_3D_data, vdisttype, providers)
  276. sectors_def( 1) = sector_type('emiss_ff ', 'anthropogenic ', .false., 'combenergy ', 'AR5 ', NULL() ) ! Fossil Fuel
  277. sectors_def( 2) = sector_type('emiss_lu ', 'anthropogenic ', .false., 'nearsurface ', 'AR5 ', NULL() ) ! Land Use (assumed near surface for the moment, but that is open for discussion)
  278. ! CMIP6
  279. sectors_def( 3) = sector_type('ENE ', 'anthropogenic ', .false., 'combenergy ', 'CMIP6 ', NULL() ) ! Energy sector
  280. sectors_def( 4) = sector_type('RCO ', 'anthropogenic ', .false., 'combrescom ', 'CMIP6 ', NULL() ) ! Residential, commercial and other
  281. sectors_def( 5) = sector_type('IND ', 'anthropogenic ', .false., 'industry ', 'CMIP6 ', NULL() ) ! Industrial sector
  282. sectors_def( 6) = sector_type('WST ', 'anthropogenic ', .false., 'waste ', 'CMIP6 ', NULL() ) ! Waste treatment and disposal
  283. sectors_def( 7) = sector_type('AGR ', 'anthropogenic ', .false., 'surface ', 'CMIP6 ', NULL() ) ! Agriculture (excl. agricultural waste burning, which is included in CMIP6 biomass burning emissions)
  284. ! CO2 emissions from AGR are zero in CMIP6
  285. sectors_def( 8) = sector_type('SLV ', 'anthropogenic ', .false., 'nearsurface ', 'CMIP6 ', NULL() ) ! Solvents production and application
  286. sectors_def( 9) = sector_type('TRA ', 'anthropogenic ', .false., 'surface ', 'CMIP6 ', NULL() ) ! Transportation sector (land)
  287. sectors_def(10) = sector_type('SHP ', 'ships ', .false., 'nearsurface ', 'CMIP6 ', NULL() ) ! International shipping
  288. sectors_def(11) = sector_type('AIR ', 'aircraft ', .true. , 'aircraft ', 'CMIP6 ', NULL() ) ! Aircraft
  289. ! -------------------------
  290. ! initialise providers info
  291. ! ------------------------
  292. do iprov = 1, numb_providers
  293. providers_def(iprov)%name = all_providers(iprov)
  294. providers_def(iprov)%nsect2d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .false.))
  295. providers_def(iprov)%nsect3d = count( (sectors_def%prov == all_providers(iprov)) .and. (sectors_def%f3d .eqv. .true.))
  296. if(okdebug) then
  297. write(gol,'("EMISS-INFO - Inventory ",a," has ",i3, " 2d-sectors, and ",i3," 3d-sectors")')&
  298. & all_providers(iprov), providers_def(iprov)%nsect2d, providers_def(iprov)%nsect3d ; call goPr
  299. endif
  300. end do
  301. ! -------------------------
  302. ! initialise GeopPotential Height on 1x1
  303. ! ------------------------
  304. do region=1, nregions
  305. call Set( gph_dat(region), status, used=.true. )
  306. end do
  307. ! ----------------------------------------
  308. ! allocate gridbox_area arrays
  309. ! ----------------------------------------
  310. allocate( gridbox_area_05( nlon720, nlat360 ) )
  311. ! OK
  312. status = 0
  313. END SUBROUTINE EMISSION_READ_INIT
  314. !EOC
  315. !--------------------------------------------------------------------------
  316. ! TM5 !
  317. !--------------------------------------------------------------------------
  318. !BOP
  319. !
  320. ! !IROUTINE: EMISSION_READ_DONE
  321. !
  322. ! !DESCRIPTION: Free allocated arrays.
  323. !\\
  324. !\\
  325. ! !INTERFACE:
  326. !
  327. subroutine emission_read_done( status )
  328. !
  329. ! !OUTPUT PARAMETERS:
  330. !
  331. integer, intent(out) :: status
  332. !
  333. ! !REVISION HISTORY:
  334. ! 1 Oct 2010 - Achim Strunk - v0
  335. !
  336. !EOP
  337. !------------------------------------------------------------------------
  338. !BOC
  339. character(len=*), parameter :: rname=mname//'/emission_read_done'
  340. deallocate( gridbox_area_05 )
  341. deallocate( used_providers )
  342. ! OK
  343. status = 0
  344. END SUBROUTINE EMISSION_READ_DONE
  345. !EOC
  346. !--------------------------------------------------------------------------
  347. ! TM5 !
  348. !--------------------------------------------------------------------------
  349. !BOP
  350. !
  351. ! !FUNCTION: EMISSION_COARSEN_TO_1X1
  352. !
  353. ! !DESCRIPTION: Coarsen the gridded information to 1x1 deg.
  354. ! (taken from GEMS/MACC repository)
  355. !\\
  356. !\\
  357. ! !INTERFACE:
  358. !
  359. function emission_coarsen_to_1x1( emis_in, dim_nlon, dim_nlat, shift_lon, status )
  360. !
  361. ! !RETURN VALUE:
  362. !
  363. real, dimension(360,180) :: emission_coarsen_to_1x1
  364. !
  365. ! !INPUT PARAMETERS:
  366. !
  367. integer, intent(in) :: dim_nlon
  368. integer, intent(in) :: dim_nlat
  369. real, intent(in) :: emis_in(dim_nlon, dim_nlat)
  370. logical, intent(in) :: shift_lon
  371. !
  372. ! OUTPUT PARAMETERS:
  373. !
  374. integer , intent(out) :: status
  375. !
  376. ! !REVISION HISTORY:
  377. ! 1 Oct 2010 - Achim Strunk - v0 for AR5
  378. ! 1 Dec 2011 - Narcisa Banda - works for any input resolution lower than 1x1
  379. ! if 1x1 can be divided into exact number of gridcells (no interpolation)
  380. ! 1 Jul 2012 - Narcisa Banda - added the shift_lon logical flag:
  381. ! true if the data is read on longitudes [0,360] (then they need to be shifted on [-180,180])
  382. ! false if the data is read already on [-180,180]
  383. !
  384. !EOP
  385. !------------------------------------------------------------------------
  386. !BOC
  387. integer :: i, j
  388. integer :: nri, nrj
  389. ! --- begin -----------------------------------
  390. ! combine grid cells :
  391. ! from [ 0,360]x[-90,90] 001:360,361:720 001:360
  392. ! to [-180,180]x[-90,90] 001:180,181:360 001:180
  393. if ((mod(dim_nlon, 360) /= 0 ) .or. (mod(dim_nlat, 180) /= 0)) then
  394. write(gol,*) 'coarsening of emissions to 1x1 does not work for this resolution'
  395. status = 1
  396. return
  397. endif
  398. nri = dim_nlon/360
  399. nrj = dim_nlat/180
  400. if (shift_lon) then
  401. ! combine grid cells :
  402. ! from [ 0,360]x[-90,90] 001:360,361:720 001:360
  403. ! to [-180,180]x[-90,90] 001:180,181:360 001:180
  404. do j = 1, 180
  405. ! west half
  406. do i = 1, 180
  407. emission_coarsen_to_1x1(i,j) = sum(emis_in(nri*180+nri*i-nri+1:nri*180+nri*i,nrj*j-nrj+1:nrj*j))
  408. end do
  409. ! east half
  410. do i = 1, 180
  411. emission_coarsen_to_1x1(180+i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j))
  412. end do
  413. end do
  414. else
  415. do j=1, 180
  416. do i=1, 360
  417. emission_coarsen_to_1x1(i,j) = sum(emis_in(nri*i-nri+1:nri*i,nrj*j-nrj+1:nrj*j))
  418. end do
  419. end do
  420. endif
  421. ! ok
  422. status = 0
  423. end function emission_coarsen_to_1x1
  424. !EOC
  425. !--------------------------------------------------------------------------
  426. ! TM5 !
  427. !--------------------------------------------------------------------------
  428. !BOP
  429. !
  430. ! !FUNCTION: VALID_YEAR
  431. !
  432. ! !DESCRIPTION: return a valid year for an emission inventory, based on
  433. ! requested year.
  434. !\\
  435. !\\
  436. ! !INTERFACE:
  437. !
  438. FUNCTION VALID_YEAR( iyear, iminmax, provider_name, verbose)
  439. !
  440. ! !RETURN VALUE:
  441. !
  442. integer :: valid_year
  443. !
  444. ! !INPUT PARAMETERS:
  445. !
  446. integer, intent(in) :: iyear, iminmax(2)
  447. character(len=*), intent(in) :: provider_name
  448. logical, intent(in) :: verbose
  449. !
  450. ! !REVISION HISTORY:
  451. ! 26 Nov 2012 - Ph. Le Sager - v0
  452. !
  453. !EOP
  454. !------------------------------------------------------------------------
  455. !BOC
  456. valid_year = MIN(iminmax(2),MAX(iyear,iminmax(1)))
  457. ! info only once a year, and per inventory
  458. if (verbose) then
  459. write(gol,'(a,i4," (avail: ",i4,"-",i4,")")') ' EMISS-INFO - EMISS YEAR for '//trim(provider_name)//' : ', &
  460. valid_year, iminmax ; call goPr
  461. end if
  462. END FUNCTION VALID_YEAR
  463. !EOC
  464. !--------------------------------------------------------------------------
  465. ! TM5 !
  466. !--------------------------------------------------------------------------
  467. !BOP
  468. !
  469. ! !IROUTINE: EMISSION_CMIP6_READSECTOR
  470. !
  471. ! !DESCRIPTION: Reading one sector of the files for the requested month and
  472. ! returning an interpolated 3d emission field (d3data)
  473. ! and, for the CMIP6 2-D sectors, an interpolated 2d field
  474. ! containing emissions from solid biofuel combustion (d2data_bf).
  475. !\\
  476. !\\
  477. ! !INTERFACE:
  478. !
  479. subroutine emission_cmip6_ReadSector( comp, iyear, imonth, sector, d3data, status, d2data_bf )
  480. !
  481. use dims , only : icalendo
  482. !
  483. ! !INPUT PARAMETERS:
  484. !
  485. character(len=*) , intent(in) :: comp
  486. integer , intent(in) :: iyear
  487. integer , intent(in) :: imonth
  488. integer , intent(in) :: sector
  489. !
  490. ! !OUTPUT PARAMETERS:
  491. !
  492. integer , intent(out) :: status
  493. real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data
  494. real, dimension(nlon360,nlat180), intent(out), optional :: d2data_bf
  495. !
  496. !EOP
  497. !------------------------------------------------------------------------
  498. !BOC
  499. character(len=*), parameter :: rname = mname//'/emission_cmip6_readsector'
  500. character(len=256) :: fname
  501. character(len=256) :: fname_gridboxarea
  502. character(len=256) :: varfilename, varname, secname
  503. integer :: lt, year, startyear
  504. character(len=25) :: sec_str, sec_str2
  505. character(len=13) :: time_str
  506. character(len=128) :: source_str
  507. character(len=50) :: version_str
  508. logical :: existfile
  509. character(len=4) :: cyear
  510. logical :: first=.true.
  511. ! --- begin -----------------------------------
  512. ! initialise target array
  513. d3data = 0.0
  514. if (present(d2data_bf)) d2data_bf = 0.0
  515. ! read in gridbox-area; once per CPU
  516. if( .not. area_found_05 ) then
  517. fname_gridboxarea = trim(emis_input_dir_cmip6)//'/'//trim(cmip6_filestr_gridboxarea)
  518. call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  519. & nlon720, nlat360, status )
  520. IF_NOTOK_RETURN(status=1)
  521. area_found_05=.true.
  522. endif
  523. ! deal with out-of-bounds requested years
  524. year = valid_year( iyear, cmip6_avail, 'CMIP6', first)
  525. first=.false.
  526. if ( trim(sectors_def(sector)%catname) == 'aircraft' .and. year < 1920 ) then
  527. ! CMIP6 aircraft emissions before 1920 are zero and not read anymore
  528. d3data(:,:,:) = 0.
  529. else
  530. ! cyear will contain strings with the years
  531. write(cyear,'(I4.4)') year
  532. ! ------------------------
  533. ! construct filename
  534. ! e.g.: <emisdir>/NOx-em-AIR-anthro_input4MIPs_emissions_CMIP_CEDS-v2016-06-18_gr_175001-179912.nc
  535. ! ------------------------
  536. if ( index(comp,'CH4') /= 1 ) then
  537. if (year >= 1750 .and. year < 1800) then
  538. time_str='175001-179912'
  539. startyear=1750
  540. else if (year >= 1800 .and. year < 1850) then
  541. time_str='180001-184912'
  542. startyear=1800
  543. else if (year >= 1850 .and. year < 1851) then
  544. time_str='185001-185012'
  545. startyear=1850
  546. else if (year >= 1851 .and. year < 1900) then
  547. time_str='185101-189912'
  548. startyear=1851
  549. else if (year >= 1900 .and. year < 1950) then
  550. time_str='190001-194912'
  551. startyear=1900
  552. else if (year >= 1950 .and. year < 2000) then
  553. time_str='195001-199912'
  554. startyear=1950
  555. else if (year >= 2000 .and. year < 2015) then
  556. time_str='200001-201412'
  557. startyear=2000
  558. else if (year >= 2015 .and. year <= 2100) then
  559. time_str='201501-210012'
  560. startyear=2015
  561. else
  562. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  563. status=1; TRACEBACK; return
  564. endif
  565. if (year >= 1750 .and. year < 2015) then
  566. if (trim(sectors_def(sector)%catname) == 'aircraft') then
  567. if ( index(comp,'SO2') /= 1 ) then
  568. version_str='2017-08-30'
  569. else
  570. ! SO2 aicraft emissions have had another update in Oct. 2017
  571. version_str='2017-10-05'
  572. endif
  573. else
  574. version_str='2017-05-18'
  575. endif
  576. else if (year >= 2015 .and. year <=2100) then
  577. version_str='1-1'
  578. else
  579. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  580. status=1; TRACEBACK; return
  581. endif
  582. else
  583. ! CH4
  584. if (year >= 1750 .and. year < 1850) then
  585. write (gol,'("WARNING - Anthropogenic emissions of CH4 not available prior to 1850")') ; call goPr
  586. write (gol,'("WARNING - 1850 values are used")') ; call goPr
  587. year = 1850
  588. endif
  589. if (year >= 1850 .and. year < 1970) then
  590. time_str='185001-196012'
  591. startyear=1850
  592. version_str='2017-05-18-supplemental-data'
  593. else if (year >= 1970 .and. year < 2015) then
  594. time_str='197001-201412'
  595. startyear=1970
  596. version_str='2017-05-18'
  597. else if (year >= 2015 .and. year <= 2100) then
  598. time_str='201501-210012'
  599. startyear=2015
  600. version_str='1-1'
  601. else
  602. write (gol,'("CMIP6 emissions beyond 2100 not available")') ; call goErr
  603. status=1; TRACEBACK; return
  604. endif
  605. endif
  606. if (year <= 2014 ) then
  607. source_str='input4MIPs_emissions_CMIP_CEDS'
  608. else
  609. select case(trim(ssp_name))
  610. case("SSP5-8.5")
  611. source_str='input4MIPs_emissions_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585'
  612. case ("SSP3-7.0")
  613. source_str='input4MIPs_emissions_ScenarioMIP_IAMC-AIM-ssp370'
  614. case ("SSP3-LowNTCF")
  615. source_str='input4MIPs_emissions_AerChemMIP_IAMC-AIM-ssp370-lowNTCF'
  616. case default
  617. write (gol,'("Emissions not implemented for scenario: ", a)') trim(ssp_name); call goErr
  618. status=1; TRACEBACK; return
  619. end select
  620. endif
  621. if ( trim(sectors_def(sector)%catname) == 'anthropogenic' .or. &
  622. trim(sectors_def(sector)%catname) == 'ships' ) then
  623. if ( index(comp,'VOC') == 1 ) then
  624. ! individual VOC species
  625. sec_str='em-speciated-VOC-anthro'
  626. sec_str2='em_speciated_VOC_anthro'
  627. version_str=trim(version_str)//'-supplemental-data'
  628. else
  629. sec_str='em-anthro'
  630. sec_str2='em_anthro'
  631. endif
  632. varname=trim(comp)//'_'//trim(sec_str2)
  633. ! change dash to underscore in few cases
  634. if ( index(varname, 'VOC') == 1 ) varname(6:6)= '_'
  635. if ( index(varname, 'hexanes-pl') == 7 ) varname(7:16) = 'hexanes_pl'
  636. if ( index(varname, 'other-') == 7 ) varname(7:12) = 'other_'
  637. else if ( trim(sectors_def(sector)%catname) == 'aircraft' ) then
  638. sec_str='em-AIR-anthro'
  639. sec_str2='em_AIR_anthro'
  640. varname=trim(comp)//'_'//trim(sec_str2)
  641. else
  642. write (gol,'("Invalid CMIP6 sector")') ; call goErr
  643. status=1; TRACEBACK; return
  644. endif
  645. varfilename=trim(comp)//'-'//trim(sec_str)
  646. ! For NO, the species name in the file name has to be set to NOx
  647. fname = trim(emis_input_dir_cmip6) //'/'// &
  648. trim(varfilename) //'_'// &
  649. trim(source_str) //'-'// &
  650. trim(version_str) //'_'// &
  651. 'gn' //'_'// &
  652. trim(time_str) // &
  653. '.nc'
  654. ! test existence of file
  655. inquire( file=trim(fname), exist=existfile)
  656. if( .not. existfile ) then
  657. write (gol,'(" CMIP6 file `",a,"` not found ")') trim(fname); call goErr
  658. status = 1; TRACEBACK; return
  659. end if
  660. ! ------------------------------------------------
  661. ! data record is read by emission_cmip6_Read2/3DRecord
  662. secname = sectors_def(sector)%name
  663. ! distinguish 2d/3d sectors
  664. if( sectors_def(sector)%f3d ) then
  665. d3data(:,:,:) = emission_cmip6_Read3DRecord( fname, varname, secname, imonth, year, startyear, status )
  666. else
  667. d3data(:,:,1) = emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  668. ! Read mass emitted by solid biofuel burning
  669. ! for carbonaceous aerosol.
  670. ! Reading of biofuel emissions is done for all 2-D sectors,
  671. ! even though in CMIP6 there are only contributions for RCO, IND, ENE and TRA.
  672. if (present(d2data_bf)) then
  673. if ( (index(comp,'BC') /= 1) .and. (index(comp,'OC') /= 1) ) then
  674. write (gol,'("Reading solid biofuel emissions only implemented for BC and OC")'); call goErr
  675. status = 1; TRACEBACK; return
  676. endif
  677. sec_str='em-SOLID-BIOFUEL-anthro'
  678. sec_str2='em_SOLID_BIOFUEL_anthro'
  679. varname=trim(comp)//'_'//trim(sec_str2)
  680. varfilename=trim(comp)//'-'//trim(sec_str)
  681. fname = trim(emis_input_dir_cmip6) //'/'// &
  682. trim(varfilename) //'_'// &
  683. trim(source_str) //'-'// &
  684. trim(version_str) //'-'// &
  685. 'supplemental-data' //'_'// &
  686. 'gn' //'_'// &
  687. trim(time_str) // &
  688. '.nc'
  689. ! test existence of file
  690. inquire( file=trim(fname), exist=existfile)
  691. if( .not. existfile ) then
  692. write (gol,'(" CMIP6 file `",a,"` not found ")') trim(fname); call goErr
  693. status = 1; TRACEBACK; return
  694. end if
  695. d2data_bf(:,:) = emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  696. endif
  697. end if
  698. endif
  699. IF_NOTOK_RETURN(status=1)
  700. end subroutine emission_cmip6_ReadSector
  701. !EOC
  702. !--------------------------------------------------------------------------
  703. ! TM5 !
  704. !--------------------------------------------------------------------------
  705. !BOP
  706. !
  707. ! !FUNCTION: EMISSION_CMIP6_READ2DRECORD
  708. !
  709. ! !DESCRIPTION: Read a single 2d record of a given file and
  710. ! return a 2d emission field interpolated on 1x1 grid.
  711. !\\
  712. !\\
  713. ! !INTERFACE:
  714. !
  715. function emission_cmip6_Read2DRecord( fname, varname, secname, imonth, year, startyear, status )
  716. !
  717. ! !RETURN VALUE:
  718. !
  719. real :: emission_cmip6_Read2DRecord(nlon360,nlat180)
  720. !
  721. ! !INPUT PARAMETERS:
  722. !
  723. character(len=*), intent(in) :: fname, varname
  724. character(len=sector_name_len), intent(in) :: secname
  725. integer, intent(in) :: imonth, year, startyear
  726. !
  727. ! !OUTPUT PARAMETERS:
  728. !
  729. integer, intent(out) :: status
  730. !
  731. !EOP
  732. !------------------------------------------------------------------------
  733. !BOC
  734. character(len=*), parameter :: rname = mname//'/emission_cmip6_Read2DRecord'
  735. character(len=256) :: fname2
  736. integer :: fid, varid, isec
  737. integer :: fid2, varid2, year_first, year_second
  738. !real :: emis_in(nlon720, nlat360, 1)
  739. real :: emis_in(nlon720, nlat360, 1, 1)
  740. real, allocatable :: emis_help(:,:,:,:)
  741. real :: x
  742. ! --- begin -----------------------------------
  743. select case( trim(secname) )
  744. case ('AGR')
  745. isec=0
  746. case ('ENE')
  747. isec=1
  748. case ('IND')
  749. isec=2
  750. case ('TRA')
  751. isec=3
  752. case ('RCO')
  753. isec=4
  754. case ('SLV')
  755. isec=5
  756. case ('WST')
  757. isec=6
  758. case ('SHP')
  759. isec=7
  760. case default
  761. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  762. secname, trim(fname) ; call goErr
  763. status=1; TRACEBACK; return
  764. end select
  765. ! initialise
  766. emission_cmip6_Read2DRecord = 0.0
  767. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  768. IF_NOTOK_RETURN(status=1)
  769. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  770. IF_ERROR_RETURN(status=1)
  771. if ( varid < 0 ) then
  772. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  773. varname, trim(fname) ; call goErr
  774. status=1; TRACEBACK; return
  775. else
  776. if( okdebug ) then
  777. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  778. trim(varname), trim(fname) ; call goPr
  779. endif
  780. ! Special case for methane emissions prior to 1970
  781. ! which are provided at 10-year intervals,
  782. ! starting at 1850.
  783. if (index(varname,'CH4') == 1 .and. year < 1970) then
  784. ! First year of the decade:
  785. year_first = int(year/10) * 10
  786. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12*(year_first-startyear)/10/) )
  787. IF_NOTOK_RETURN(status=1)
  788. if (year /= year_first) then
  789. ! Also read data for the first year of the next decade
  790. ! and apply a linear interpolation between the two years
  791. allocate(emis_help(nlon720, nlat360, 1, 1))
  792. year_second = year_first + 10
  793. if (year_second == 1970) then
  794. ! Read 1970 data from the regular 1970-2014 file
  795. fname2 = trim(emis_input_dir_cmip6)//'/'// &
  796. 'CH4-em-anthro_input4MIPs_emissions_CMIP_CEDS-2017-05-18_gn_197001-201412.nc'
  797. CALL MDF_Open( TRIM(fname2), MDF_NETCDF, MDF_READ, fid2, status )
  798. IF_NOTOK_RETURN(status=1)
  799. CALL MDF_Inq_VarID( fid2, TRIM(varname), varid2, status )
  800. IF_ERROR_RETURN(status=1)
  801. if ( varid2 < 0 ) then
  802. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  803. varname, trim(fname2) ; call goErr
  804. status=1; TRACEBACK; return
  805. else
  806. if ( okdebug ) then
  807. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  808. trim(varname), trim(fname2) ; call goPr
  809. endif
  810. CALL MDF_Get_Var( fid2, varid2, emis_help, status, start=(/1,1,isec+1,imonth/) )
  811. IF_NOTOK_RETURN(status=1)
  812. endif
  813. CALL MDF_Close( fid2, status )
  814. IF_NOTOK_RETURN(status=1)
  815. else
  816. ! Read from the file containing the data prior to 1970,
  817. ! which is already open
  818. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12*(year_second-startyear)/10/) )
  819. endif
  820. ! Interpolate montly data between the two provided years
  821. x = float(year-year_first)/10.
  822. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  823. deallocate(emis_help)
  824. endif
  825. ! SSP scenario emissions are provided for 2015, 2020, 2030, ... 2100
  826. else if (year >= 2015 .and. year < 2020) then
  827. ! First year of the period
  828. year_first = 2015
  829. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth/) )
  830. IF_NOTOK_RETURN(status=1)
  831. if (year /= year_first) then
  832. ! Also read data for 2020
  833. ! and apply a linear interpolation between the two years
  834. allocate(emis_help(nlon720, nlat360, 1, 1))
  835. year_second = 2020
  836. ! Read data for 2020 by raising the index by 12
  837. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12/) )
  838. ! Interpolate montly data between the two provided years
  839. x = float(year-year_first)/5.
  840. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  841. deallocate(emis_help)
  842. endif
  843. else if (year >= 2020) then
  844. ! First year of the decade:
  845. year_first = int(year/10) * 10
  846. ! Change to reference year to 2020 by raising the index by 12
  847. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12+12*(year_first-2020)/10/) )
  848. IF_NOTOK_RETURN(status=1)
  849. if (year /= year_first) then
  850. ! Also read data for the first year of the next decade
  851. ! and apply a linear interpolation between the two years
  852. allocate(emis_help(nlon720, nlat360, 1, 1))
  853. year_second = year_first + 10
  854. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,isec+1,imonth+12+12*(year_second-2020)/10/) )
  855. ! Interpolate monthly data between the two provided years
  856. x = float(year-year_first)/10.
  857. emis_in(:,:,1,1) = (1.-x) * emis_in(:,:,1,1) + x * emis_help(:,:,1,1)
  858. deallocate(emis_help)
  859. endif
  860. else
  861. ! read yearly emissions directly from file
  862. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,isec+1,imonth+12*(year-startyear)/) )
  863. IF_NOTOK_RETURN(status=1)
  864. endif
  865. ! convert from kg(species)/m^2/s to kg(species)/gridbox/s
  866. emis_in(:,:,1,1) = emis_in(:,:,1,1) * gridbox_area_05
  867. ! now coarsen to nlon360,nlat180
  868. emission_cmip6_Read2DRecord = emission_coarsen_to_1x1( emis_in(:,:,1,1), nlon720, nlat360,.false., status )
  869. IF_NOTOK_RETURN(status=1)
  870. end if
  871. CALL MDF_Close( fid, status )
  872. IF_NOTOK_RETURN(status=1)
  873. status = 0
  874. return
  875. end function emission_cmip6_Read2DRecord
  876. !EOC
  877. !--------------------------------------------------------------------------
  878. ! TM5 !
  879. !--------------------------------------------------------------------------
  880. !BOP
  881. !
  882. ! !FUNCTION: EMISSION_CMIP6_READ3DRECORD
  883. !
  884. ! !DESCRIPTION: read one 3D sector
  885. !
  886. !\\
  887. !\\
  888. ! !INTERFACE:
  889. !
  890. function emission_cmip6_Read3DRecord( fname, varname, secname, imonth, year, startyear, status )
  891. !
  892. ! !RETURN VALUE:
  893. !
  894. real :: emission_cmip6_Read3DRecord(nlon360,nlat180,ar5_dim_3ddata)
  895. !
  896. ! !INPUT/OUTPUT PARAMETERS:
  897. !
  898. character(len=*), intent(in) :: fname, varname
  899. character(32), intent(in) :: secname
  900. !
  901. ! !INPUT PARAMETERS:
  902. !
  903. integer, intent(in) :: imonth, year, startyear
  904. !
  905. ! !OUTPUT PARAMETERS:
  906. !
  907. integer, intent(out) :: status
  908. !
  909. ! !REVISION HISTORY:
  910. ! 1 Oct 2010 - Achim Strunk -
  911. !
  912. ! !REMARKS:
  913. !
  914. !EOP
  915. !------------------------------------------------------------------------
  916. !BOC
  917. character(len=*), parameter :: rname = mname//'/emission_cmip6_Read3DRecord'
  918. integer :: fid, varid, lk
  919. real, dimension(nlon720,nlat360,ar5_dim_3ddata,1) :: emis_in
  920. integer :: fid2, varid2, year_first, year_second
  921. real, allocatable :: emis_help(:,:,:,:)
  922. real :: x
  923. real, parameter :: layer_depth = 610. ! fixed height (m) of the vertical levels
  924. ! on which the CMIP6 aircraft emissions
  925. ! are provided.
  926. ! --- begin -----------------------------------
  927. ! initialise
  928. emission_cmip6_Read3DRecord = 0.0
  929. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  930. IF_NOTOK_RETURN(status=1)
  931. CALL MDF_Inq_VarID( fid, TRIM(varname), varid, status )
  932. IF_ERROR_RETURN(status=1)
  933. if ( varid < 0 ) then
  934. write (gol,'("EMISS - CMIP6 - no `",a,"` emissions in file ",a)') &
  935. secname, trim(fname) ; call goErr
  936. status=1; TRACEBACK; return
  937. else
  938. if( okdebug ) then
  939. write (gol,'("EMISS-INFO - CMIP6 - found `",a,"` emissions in file ",a)') &
  940. secname, trim(fname) ; call goPr
  941. endif
  942. ! SSP scenario emissions are provided for 2015, 2020, 2030, ... 2100
  943. if (year >= 2015 .and. year < 2020) then
  944. ! First year of the period
  945. year_first = 2015
  946. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth/) )
  947. IF_NOTOK_RETURN(status=1)
  948. if (year /= year_first) then
  949. ! Also read data for 2020
  950. ! and apply a linear interpolation between the two years
  951. allocate(emis_help(nlon720, nlat360, ar5_dim_3ddata, 1))
  952. year_second = 2020
  953. ! Read data for 2020 by raising the index by 12
  954. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,1,imonth+12/) )
  955. ! Interpolate montly data between the two provided years
  956. x = float(year-year_first)/5.
  957. emis_in(:,:,:,1) = (1.-x) * emis_in(:,:,:,1) + x * emis_help(:,:,:,1)
  958. deallocate(emis_help)
  959. endif
  960. else if (year >= 2020) then
  961. ! First year of the decade:
  962. year_first = int(year/10) * 10
  963. ! Change to reference year to 2020 by raising the index by 12
  964. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth+12+12*(year_first-2020)/10/) )
  965. IF_NOTOK_RETURN(status=1)
  966. if (year /= year_first) then
  967. ! Also read data for the first year of the next decade
  968. ! and apply a linear interpolation between the two years
  969. allocate(emis_help(nlon720, nlat360, ar5_dim_3ddata, 1))
  970. year_second = year_first + 10
  971. CALL MDF_Get_Var( fid, varid, emis_help, status, start=(/1,1,1,imonth+12+12*(year_second-2020)/10/) )
  972. ! Interpolate monthly data between the two provided years
  973. x = float(year-year_first)/10.
  974. emis_in(:,:,:,1) = (1.-x) * emis_in(:,:,:,1) + x * emis_help(:,:,:,1)
  975. deallocate(emis_help)
  976. endif
  977. else
  978. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,1,imonth+12*(year-startyear)/) )
  979. IF_NOTOK_RETURN(status=1)
  980. endif
  981. do lk = 1, ar5_dim_3ddata
  982. ! convert from kg(species)/m^2/s to kg(species)/m/s;
  983. ! Note that CMIP6 aircraft emissions are given in kg(species)/m^2/s,
  984. ! while AR5 aircraft emissions are given in kg(species)/m^3/s.
  985. ! In order to be able to use the same vertical regridding routine lateron,
  986. ! we convert to the same unit and include a division by the layer depth.
  987. emis_in(:,:,lk,1) = emis_in(:,:,lk,1) * gridbox_area_05 / layer_depth
  988. ! now coarsen to nlon360,nlat180
  989. emission_cmip6_Read3DRecord(:,:,lk) = emission_coarsen_to_1x1( emis_in(:,:,lk,1) ,&
  990. & nlon720, nlat360, .false., status )
  991. IF_NOTOK_RETURN(status=1)
  992. end do
  993. end if
  994. CALL MDF_Close( fid, status )
  995. IF_NOTOK_RETURN(status=1)
  996. status = 0
  997. return
  998. end function emission_cmip6_Read3DRecord
  999. !EOC
  1000. !--------------------------------------------------------------------------
  1001. ! TM5 !
  1002. !--------------------------------------------------------------------------
  1003. !BOP
  1004. !
  1005. ! !IROUTINE: EMISSION_AR5_READCO2
  1006. !
  1007. ! !DESCRIPTION: Reading one sector of the files to be interpolated and
  1008. ! returning an interpolated 3d emission field (d3data)
  1009. !\\
  1010. !\\
  1011. ! !INTERFACE:
  1012. !
  1013. subroutine emission_ar5_ReadCO2( comp, iyear, imonth, sector, d3data, status )
  1014. !
  1015. ! !INPUT PARAMETERS:
  1016. !
  1017. character(len=*) , intent(in) :: comp
  1018. integer , intent(in) :: iyear
  1019. integer , intent(in) :: imonth
  1020. integer , intent(in) :: sector
  1021. !
  1022. ! !OUTPUT PARAMETERS:
  1023. !
  1024. integer , intent(out) :: status
  1025. real, dimension(nlon360,nlat180,ar5_dim_3ddata), intent(out) :: d3data
  1026. !
  1027. ! !REVISION HISTORY:
  1028. ! 1 Oct 2010 - Achim Strunk - v0
  1029. !
  1030. !EOP
  1031. !------------------------------------------------------------------------
  1032. !BOC
  1033. character(len=*), parameter :: rname = mname//'/emission_ar5_readCO2'
  1034. character(len=256) :: fname
  1035. character(len=256) :: fname_gridboxarea
  1036. character(32) :: secname
  1037. integer :: lt, year
  1038. logical :: existfile
  1039. integer, dimension(2) :: ltimes
  1040. character(len=4), dimension(2) :: ar5_cyears
  1041. real, dimension(2) :: ar5_ipcoef_years
  1042. logical :: first=.true.
  1043. real :: co2_rcp_target, co2_scale
  1044. ! --- begin -----------------------------------
  1045. ! initialise target array
  1046. d3data = 0.0
  1047. ! read in gridbox-area; once per CPU
  1048. ! For CO2 the area field is read from the CO2 LU file
  1049. !if( .not. area_found_05 ) then
  1050. ! fname_gridboxarea = trim(emis_input_dir_ar5)//'/'//trim(ar5_filestr_gridboxarea)
  1051. ! call emission_ReadGridboxArea(fname_gridboxarea, 'gridbox_area', gridbox_area_05, &
  1052. ! & nlon720, nlat360, status )
  1053. ! IF_NOTOK_RETURN(status=1)
  1054. ! area_found_05=.true.
  1055. !endif
  1056. ! deal with out-of-bounds requested years
  1057. year = valid_year( iyear, ar5_avail, 'AR5', first)
  1058. first=.false.
  1059. secname = sectors_def(sector)%name
  1060. if ( iyear > year ) then
  1061. ! ------------------------
  1062. ! data for the year ar5_avail(2)=2005 will be read from file
  1063. ! and need to be scaled (index=1: earlier year; index=2: later year)
  1064. ! ------------------------
  1065. ! ----------------------------------------
  1066. ! get the right times to interpolate and related coefficients
  1067. ! (ar5_avail_yrs(ltimes))
  1068. !
  1069. ! --> resulting scale factor will be a linear interpolation between neighbouring values
  1070. !
  1071. ! ----------------------------------------
  1072. allocate( ltimeind( ar5_nr_avail_yrs ) )
  1073. ltimeind = .false.
  1074. where( ar5_avail_yrs < iyear ) ltimeind = .true.
  1075. ! times(1): index representing time instance earlier than current year
  1076. ! times(2): -"- -"- later than current year
  1077. ltimes(2) = count( ltimeind ) + 1
  1078. ltimes(1) = ltimes(2) - 1
  1079. ! check a match with available years
  1080. ! (in order to use only value instead of two)
  1081. if( ar5_avail_yrs(ltimes(2)) == iyear ) &
  1082. ltimes(1) = ltimes(2)
  1083. deallocate( ltimeind )
  1084. ! ar5_cyears will contain strings with the years
  1085. write(ar5_cyears(1),'(I4.4)') ar5_avail_yrs(ltimes(1))
  1086. write(ar5_cyears(2),'(I4.4)') ar5_avail_yrs(ltimes(2))
  1087. ! ar5_ipcoef_years will contain interpolation coefficients
  1088. ! default: factors 1.0/0.0
  1089. ar5_ipcoef_years(1) = 1.0
  1090. ar5_ipcoef_years(2) = 0.0
  1091. if( ltimes(2) /= ltimes(1) ) then
  1092. ar5_ipcoef_years(1) = (ar5_avail_yrs(ltimes(2)) - iyear) / &
  1093. real( ar5_avail_yrs(ltimes(2)) - ar5_avail_yrs(ltimes(1)) )
  1094. ar5_ipcoef_years(2) = 1.0 - ar5_ipcoef_years(1)
  1095. end if
  1096. select case (trim (secname) )
  1097. case ( 'emiss_ff' )
  1098. co2_ref=co2_ff_ref
  1099. select case (trim(filestr_rcpiden) )
  1100. case ('RCP26')
  1101. co2_rcp(:)=co2ff_rcp26(:)
  1102. case ('RCP45')
  1103. co2_rcp(:)=co2ff_rcp45(:)
  1104. case ('RCP60')
  1105. co2_rcp(:)=co2ff_rcp60(:)
  1106. case ('RCP85')
  1107. co2_rcp(:)=co2ff_rcp85(:)
  1108. case default
  1109. write(gol, '("ERROR: no RCP scenario specified for CO2 emissions")') ; call goErr
  1110. end select
  1111. case ( 'emiss_lu')
  1112. co2_ref=co2_lu_ref
  1113. select case (trim(filestr_rcpiden) )
  1114. case ('RCP26')
  1115. co2_rcp(:)=co2lu_rcp26(:)
  1116. case ('RCP45')
  1117. co2_rcp(:)=co2lu_rcp45(:)
  1118. case ('RCP60')
  1119. co2_rcp(:)=co2lu_rcp60(:)
  1120. case ('RCP85')
  1121. co2_rcp(:)=co2lu_rcp85(:)
  1122. end select
  1123. end select
  1124. co2_rcp_target=co2_rcp(ltimes(1))*ar5_ipcoef_years(1)+co2_rcp(ltimes(2))*ar5_ipcoef_years(2)
  1125. co2_scale=co2_rcp_target/co2_ref
  1126. else
  1127. ! no scaling for years <= 2005
  1128. co2_scale=1.
  1129. endif
  1130. ! ------------------------
  1131. ! read CO2 emission file
  1132. ! ------------------------
  1133. select case ( trim (secname) )
  1134. case ( 'emiss_ff' )
  1135. fname = trim(emis_input_dir_ar5) //'/'// &
  1136. 'CMIP5_gridcar_CO2_emissions_fossil_fuel_Andres_1751-2007_monthly_SC_mask11.nc'
  1137. case ( 'emiss_lu' )
  1138. fname = trim(emis_input_dir_ar5) //'/'// &
  1139. 'carbon_emissions_landuse_20person.nc'
  1140. case default
  1141. write(gol, '("ERROR: emission sector ",a,"not available for CO2")') &
  1142. trim(secname); call goErr
  1143. status=1; return
  1144. end select
  1145. ! test existence of file
  1146. inquire( file=trim(fname), exist=existfile)
  1147. if( .not. existfile ) then
  1148. write (gol,'("ERROR: file `",a,"` not found ")') trim(fname); call goErr
  1149. status=1; return
  1150. end if
  1151. select case ( trim (secname) )
  1152. case ( 'emiss_ff' )
  1153. d3data(:,:,1) = d3data(:,:,1) + co2_scale * &
  1154. emission_ar5_ReadCO2FF( fname, year, imonth, status )
  1155. case ( 'emiss_lu' )
  1156. d3data(:,:,1) = d3data(:,:,1) + co2_scale * &
  1157. emission_ar5_ReadCO2LU( fname, year, status )
  1158. case default
  1159. write(gol, '("ERROR: emission sector ",a,"not available for CO2")') &
  1160. trim(secname); call goErr
  1161. status=1; return
  1162. end select
  1163. IF_NOTOK_RETURN(status=1)
  1164. end subroutine emission_ar5_ReadCO2
  1165. !EOC
  1166. !--------------------------------------------------------------------------
  1167. ! TM5 !
  1168. !--------------------------------------------------------------------------
  1169. !BOP
  1170. !
  1171. ! !FUNCTION: EMISSION_AR5_READCO2FF
  1172. !
  1173. ! !DESCRIPTION: Read monthly AR5 fossil-fuel CO2 emissions on a 1x1 grid
  1174. !\\
  1175. !\\
  1176. ! !INTERFACE:
  1177. !
  1178. function emission_ar5_ReadCO2FF( fname, year, imonth, status )
  1179. !
  1180. ! !RETURN VALUE:
  1181. !
  1182. real :: emission_ar5_ReadCO2FF(360,180)
  1183. !
  1184. ! !INPUT PARAMETERS:
  1185. !
  1186. character(len=*), intent(in) :: fname
  1187. integer, intent(in) :: year, imonth
  1188. !
  1189. ! !OUTPUT PARAMETERS:
  1190. !
  1191. integer, intent(out) :: status
  1192. !
  1193. ! !REVISION HISTORY:
  1194. ! 20 May 2014 - T. van Noije
  1195. !
  1196. !EOP
  1197. !------------------------------------------------------------------------
  1198. !BOC
  1199. character(len=*), parameter :: rname = mname//'/emission_ar5_ReadCO2FF'
  1200. integer :: fid, varid
  1201. real :: emis_in(360, 180), area(360,180)
  1202. ! --- begin -----------------------------------
  1203. ! initialise
  1204. emission_ar5_ReadCO2FF = 0.0
  1205. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  1206. IF_NOTOK_RETURN(status=1)
  1207. CALL MDF_Inq_VarID( fid, 'FF', varid, status )
  1208. IF_ERROR_RETURN(status=1)
  1209. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,12*(year-1751)+imonth/) )
  1210. IF_NOTOK_RETURN(status=1)
  1211. CALL MDF_Inq_VarID( fid, 'AREA', varid, status )
  1212. IF_ERROR_RETURN(status=1)
  1213. CALL MDF_Get_Var( fid, varid, area, status, start=(/1,1/) )
  1214. IF_NOTOK_RETURN(status=1)
  1215. ! to speed up reading of area could be done only once
  1216. ! convert from g(C)/m^2/s to kg(CO2)/gridbox/s
  1217. emission_ar5_ReadCO2FF(:,:) = emis_in(:,:) * area(:,:) * 1.e-3 * xmco2/xmc
  1218. IF_NOTOK_RETURN(status=1)
  1219. CALL MDF_Close( fid, status )
  1220. IF_NOTOK_RETURN(status=1)
  1221. status = 0
  1222. return
  1223. end function emission_ar5_ReadCO2FF
  1224. !EOC
  1225. !--------------------------------------------------------------------------
  1226. ! TM5 !
  1227. !--------------------------------------------------------------------------
  1228. !BOP
  1229. !
  1230. ! !FUNCTION: EMISSION_AR5_READCO2LU
  1231. !
  1232. ! !DESCRIPTION: Read yearly AR5 land-use CO2 emissions on a 0.5x0.5 grid
  1233. ! and convert to a 1x1 grid
  1234. !\\
  1235. !\\
  1236. ! !INTERFACE:
  1237. !
  1238. function emission_ar5_ReadCO2LU( fname, year, status )
  1239. !
  1240. ! !RETURN VALUE:
  1241. !
  1242. real :: emission_ar5_ReadCO2LU(nlon360,nlat180)
  1243. !
  1244. ! !INPUT PARAMETERS:
  1245. !
  1246. character(len=*), intent(in) :: fname
  1247. integer, intent(in) :: year
  1248. !
  1249. ! !OUTPUT PARAMETERS:
  1250. !
  1251. integer, intent(out) :: status
  1252. !
  1253. ! !REVISION HISTORY:
  1254. ! 20 May 2014 - T. van Noije
  1255. !
  1256. !EOP
  1257. !------------------------------------------------------------------------
  1258. !BOC
  1259. character(len=*), parameter :: rname = mname//'/emission_ar5_ReadCO2LU'
  1260. integer :: fid, varid
  1261. real :: emis_in(nlon720, nlat360), area(nlon720, nlat360)
  1262. ! --- begin -----------------------------------
  1263. ! initialise
  1264. emission_ar5_ReadCO2LU = 0.0
  1265. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  1266. IF_NOTOK_RETURN(status=1)
  1267. CALL MDF_Inq_VarID( fid, 'carbon_emission', varid, status )
  1268. IF_ERROR_RETURN(status=1)
  1269. CALL MDF_Get_Var( fid, varid, emis_in, status, start=(/1,1,year-1850+1/) )
  1270. IF_NOTOK_RETURN(status=1)
  1271. CALL MDF_Inq_VarID( fid, 'area', varid, status )
  1272. IF_ERROR_RETURN(status=1)
  1273. CALL MDF_Get_Var( fid, varid, area, status, start=(/1,1/) )
  1274. IF_NOTOK_RETURN(status=1)
  1275. ! to speed up reading of area could be done only once
  1276. ! convert from g(C)/m^2/s to kg(CO2)/gridbox/s
  1277. !emis_in(:,:) = emis_in(:,:) * gridbox_area_05(:,:) * 1.e-3 * xmco2/xmc
  1278. emis_in(:,:) = emis_in(:,:) * area(:,:) * 1.e-3 * xmco2/xmc
  1279. ! now coarsen to nlon360,nlat180
  1280. emission_ar5_ReadCO2LU = emission_coarsen_to_1x1( emis_in(:,:), nlon720, nlat360,.true., status )
  1281. IF_NOTOK_RETURN(status=1)
  1282. CALL MDF_Close( fid, status )
  1283. IF_NOTOK_RETURN(status=1)
  1284. status = 0
  1285. return
  1286. end function emission_ar5_ReadCO2LU
  1287. !EOC
  1288. !--------------------------------------------------------------------------
  1289. ! TM5 !
  1290. !--------------------------------------------------------------------------
  1291. !BOP
  1292. !
  1293. ! !IROUTINE: EMISSION_READGRIDBOXAREA
  1294. !
  1295. ! !DESCRIPTION:
  1296. ! reading gridbox surface areas for 0.5 x 0.5 Edgar 4
  1297. ! needed to scale the emissions from mass/m^2 to mass/grid
  1298. !\\
  1299. !\\
  1300. ! !INTERFACE:
  1301. !
  1302. subroutine emission_ReadGridboxArea(fname, recname, gridbox_area, dim_nlon, dim_nlat, status )
  1303. !
  1304. ! !INPUT PARAMETERS:
  1305. !
  1306. character(len=*), intent(in) :: fname
  1307. character(len=*), intent(in) :: recname
  1308. integer, intent(in) :: dim_nlon
  1309. integer, intent(in) :: dim_nlat
  1310. !
  1311. ! !OUTPUT PARAMETERS:
  1312. !
  1313. integer, intent(out) :: status
  1314. real, dimension(dim_nlon, dim_nlat), intent(out) :: gridbox_area
  1315. !
  1316. ! !REVISION HISTORY:
  1317. !
  1318. ! 1 Oct 2010 - Achim Strunk - v0
  1319. ! 1 Dec 2011 - Narcisa Banda - generalized it for any gridbox area size
  1320. !
  1321. ! !REMARKS:
  1322. !
  1323. !EOP
  1324. !------------------------------------------------------------------------
  1325. !BOC
  1326. character(len=*), parameter :: rname = mname//'/emission_ReadGridboxArea'
  1327. integer :: fid, varid
  1328. ! --- begin -----------------------------------
  1329. CALL MDF_Open( TRIM(fname), MDF_NETCDF, MDF_READ, fid, status )
  1330. IF_NOTOK_RETURN(status=1)
  1331. CALL MDF_Inq_VarID( fid, TRIM(recname), varid, status )
  1332. IF_ERROR_RETURN(status=1)
  1333. CALL MDF_Get_Var( fid, varid, gridbox_area, status )
  1334. IF_NOTOK_RETURN(status=1)
  1335. CALL MDF_Close( fid, status )
  1336. IF_NOTOK_RETURN(status=1)
  1337. status = 0
  1338. end subroutine emission_ReadGridboxArea
  1339. !EOC
  1340. !--------------------------------------------------------------------------
  1341. ! TM5 !
  1342. !--------------------------------------------------------------------------
  1343. !BOP
  1344. !
  1345. ! !IROUTINE: EMISSION_AR5_REGRID_AIRCRAFT
  1346. !
  1347. ! !DESCRIPTION: Vertical regridding of the AR5 aircraft data.
  1348. ! The vertical levels of the input data are hard coded.
  1349. ! (Taken from GFED_daily_AR5 (VH) and left as is)
  1350. !\\
  1351. !\\
  1352. ! !INTERFACE:
  1353. !
  1354. subroutine emission_ar5_regrid_aircraft(region, i0, j0, field_in, field_out, status )
  1355. !
  1356. ! !USES:
  1357. !
  1358. use meteodata, only : gph_dat
  1359. use tm5_distgrid, only : dgrid, get_distgrid
  1360. use dims, only : lm
  1361. !
  1362. ! !OUTPUT PARAMETERS:
  1363. !
  1364. integer, intent(out) :: status
  1365. !
  1366. ! !INPUT PARAMETERS:
  1367. !
  1368. integer, intent(in) :: region, i0, j0
  1369. real, dimension(i0:, j0:, 1:), intent(in) :: field_in
  1370. real, dimension(i0:, j0:, 1:), intent(out) :: field_out
  1371. !
  1372. ! !REVISION HISTORY:
  1373. ! 1 Oct 2010 - Achim Strunk - Taken from GFED_daily_AR5 (VH) and left as is
  1374. ! 3 Dec 2012 - Ph. Le Sager - modified for lat-lon mpi decomposition
  1375. ! - work with zoom regions
  1376. ! - mass conservation per column
  1377. !
  1378. ! !REMARKS:
  1379. !
  1380. !EOP
  1381. !------------------------------------------------------------------------
  1382. !BOC
  1383. character(len=*), parameter :: rname = mname//'/emission_ar5_regrid_aircraft'
  1384. integer, parameter :: lm_in=25
  1385. real, dimension(:,:,:), pointer :: gph ! geopotential height (m)
  1386. integer :: i,j,l
  1387. real, dimension(lm_in) :: height_in_min, height_in_max
  1388. real, allocatable :: dz(:), height(:)
  1389. real :: height_min,height_max
  1390. real :: height_out_min,height_out_max
  1391. real, dimension(lm_in), parameter :: height_in=(/ & ! Height in meter
  1392. 305., 915., 1525., 2135., 2745., 3355., 3965., 4575., 5185., 5795., &
  1393. 6405., 7015., 7625., 8235., 8845., 9455.,10065.,10675.,11285., &
  1394. 11895.,12505.,13115.,13725.,14335.,14945./)
  1395. real :: dz_in(25)
  1396. integer :: l_in, i1, i2, j1, j2, lmr
  1397. real :: total_in, total_out, total_ratio
  1398. ! --- begin --------------------------------------
  1399. call golabel()
  1400. gph => gph_dat(region)%data
  1401. CALL GET_DISTGRID( dgrid(region), I_STRT=i1, I_STOP=i2, J_STRT=j1, J_STOP=j2 )
  1402. lmr = lm(region)
  1403. allocate(dz(lmr), height(lmr+1))
  1404. ! sanity check
  1405. if (okdebug) then
  1406. if (i1/=i0 .or. j1/=j0) then
  1407. status = 1 ; TRACEBACK
  1408. return
  1409. end if
  1410. if (lm_in /= ubound(field_in,3) ) then
  1411. write(gol,*)'wrong vertical input resolution'; call goErr
  1412. status = 1
  1413. TRACEBACK; return
  1414. endif
  1415. if ((ubound(field_out,3)+1) /= ubound(gph,3)) then
  1416. write(gol,*)'wrong vertical output resolution'; call goErr
  1417. status = 1
  1418. TRACEBACK; return
  1419. endif
  1420. end if
  1421. ! locally flat atmosphere assumed
  1422. ! area linear in i,j
  1423. ! height above sea level
  1424. height_in_min(1)=0.
  1425. do l_in = 2,lm_in
  1426. height_in_min(l_in)=(height_in(l_in-1)+height_in(l_in))/2.
  1427. enddo
  1428. height_in_max(lm_in)=15555.
  1429. do l_in = 1,lm_in-1
  1430. height_in_max(l_in)=(height_in(l_in)+height_in(l_in+1))/2.
  1431. enddo
  1432. ! init
  1433. field_out = 0.0
  1434. ! regrid
  1435. do i=i1, i2
  1436. do j=j1, j2
  1437. total_in = 0.0
  1438. ! calculate total input emissions
  1439. do l_in=1, lm_in
  1440. dz_in(l_in) = height_in_max(l_in)-height_in_min(l_in)
  1441. total_in =total_in + field_in(i,j,l_in)*dz_in(l_in)
  1442. enddo
  1443. ! zero based height:
  1444. height(1) = 0.0
  1445. do l=1, lmr
  1446. dz(l) = gph(i,j,l+1) - gph(i,j,l)
  1447. height(l+1) = height(l) + dz(l)
  1448. enddo
  1449. do l=1,lmr-1
  1450. height_out_min=height(l)
  1451. height_out_max=height(l+1)
  1452. ! write(*,*)'DO AR5- regrid - C2',i,j,l,height_out_min,height_out_max
  1453. do l_in=1,lm_in
  1454. if (height_out_max .le. height_in_min(l_in)) exit
  1455. if (height_out_min .lt. height_in_max(l_in)) then
  1456. height_max=min(height_out_max,height_in_max(l_in))
  1457. height_min=max(height_out_min,height_in_min(l_in))
  1458. ! helpfield as field_in is ordered from high to low
  1459. ! field_out(i,j,l) = field_out(i,j,l) + helpfield2(i,j,lm_in-l_in+1)* &
  1460. ! (height_max-height_min)/(height_in_max(l_in)-height_in_min(l_in))
  1461. ! helpfield as field_in is ordered from low to high
  1462. ! write(*,*)'DO AR5- regrid - C',i,j,l,l_in,height_max-height_min
  1463. field_out(i,j,l) = field_out(i,j,l) + field_in(i,j,l_in)* &
  1464. (height_max-height_min) ! kg/m -> kg / gridbox
  1465. endif
  1466. enddo
  1467. enddo
  1468. ! conserve total exactly: not possible because units are in kg/m...
  1469. total_out = sum(field_out(i,j,:))
  1470. if (total_out /= 0) then
  1471. total_ratio = total_in/total_out
  1472. field_out(i,j,:) = field_out(i,j,:)*total_ratio
  1473. end if
  1474. enddo
  1475. enddo
  1476. deallocate(dz, height)
  1477. call golabel()
  1478. ! ok
  1479. status = 0
  1480. end subroutine emission_ar5_regrid_aircraft
  1481. !EOC
  1482. END MODULE EMISSION_READ