sources_sinks__co2.F90 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375
  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: SOURCES_SINKS
  13. !
  14. ! !DESCRIPTION: Perform all calculations needed for CO2 transport simulation
  15. ! in TM5: this is mainly emissions, process updates after
  16. ! changes in meteo,...
  17. !
  18. !FD: all emission are converted to kg X (fmw) /month exceptions are mentioned in the code
  19. !
  20. !\\
  21. !\\
  22. ! !INTERFACE:
  23. !
  24. MODULE SOURCES_SINKS
  25. !
  26. ! !USES:
  27. !
  28. use GO, only : gol, goErr, goPr, goBug, goLabel
  29. implicit none
  30. private
  31. !
  32. ! !PUBLIC MEMBER FUNCTIONS:
  33. !
  34. PUBLIC :: SOURCES_SINKS_INIT, SOURCES_SINKS_DONE ! Init and Done methods
  35. PUBLIC :: SS_MONTHLY_UPDATE ! monthly initialization (photolysis,..)
  36. PUBLIC :: SS_AFTER_READ_METEO_UPDATE ! Update SS after met fields are updated. Called from modelIntegration/Proces_update
  37. PUBLIC :: SOURCES_SINKS_APPLY ! apply SS
  38. !
  39. ! !PRIVATE DATA MEMBERS:
  40. !
  41. character(len=*), parameter :: mname = 'sources_sinks'
  42. !
  43. ! !REVISION HISTORY:
  44. ! 19 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  45. ! 14 May 2014 - T. van Noije- made stripped version for CO2 version
  46. !
  47. ! !REMARKS:
  48. !
  49. !EOP
  50. !------------------------------------------------------------------------------
  51. contains
  52. !------------------------------------------------------------------------------
  53. ! TM5 !
  54. !------------------------------------------------------------------------------
  55. !BOP
  56. !
  57. ! !IROUTINE: SOURCES_SINKS_INIT
  58. !
  59. ! !DESCRIPTION: switch ON required meteo; init emissions
  60. !\\
  61. !\\
  62. ! !INTERFACE:
  63. !
  64. SUBROUTINE SOURCES_SINKS_INIT( status )
  65. !
  66. ! !USES:
  67. !
  68. ! use meteo, only : Set
  69. ! use meteodata, only : temper_dat, humid_dat, oro_dat, gph_dat
  70. ! use Meteodata, only : cp_dat, lsp_dat
  71. ! use Meteodata, only : cvl_dat, cvh_dat, tv_dat
  72. ! use Meteodata, only : ci_dat, sd_dat, swvl1_dat
  73. ! use Meteodata, only : t2m_dat, d2m_dat
  74. ! use Meteodata, only : u10m_dat, v10m_dat, lsmask_dat, ci_dat
  75. ! use Meteodata, only : ssr_dat, sshf_dat, slhf_dat, ewss_dat, nsss_dat
  76. ! use Meteodata, only : u10m_dat, v10m_dat, src_dat, albedo_dat, nveg
  77. #ifndef without_emission
  78. use emission, only : Emission_Init
  79. #endif
  80. use GO, only : TrcFile, Init, Done, ReadRc
  81. use global_data, only : rcfile
  82. use dims, only : iglbsfc, nregions
  83. !
  84. ! !OUTPUT PARAMETERS:
  85. !
  86. integer, intent(out) :: status
  87. !
  88. ! !REVISION HISTORY:
  89. !
  90. ! !REMARKS:
  91. !
  92. !EOP
  93. !------------------------------------------------------------------------------
  94. !BOC
  95. integer, parameter :: kr=31 ! standard unit to read auxiliary files
  96. character(len=*), parameter :: rname = mname//'/Sources_Sinks_Init'
  97. type(TrcFile) :: rcF
  98. integer :: region, iveg
  99. ! --- begin ---------------------------------
  100. !--------------------------------------------------
  101. ! ** select meteo (cases not accounted for in the **_init procedures)
  102. !--------------------------------------------------
  103. ! do region = 1, nregions
  104. ! #ifndef without_emission
  105. ! call Set( temper_dat(region), status, used=.true. )
  106. ! call Set( humid_dat(region), status, used=.true. )
  107. ! call Set( oro_dat(region), status, used=.true. )
  108. ! call Set( gph_dat(region), status, used=.true. )
  109. ! #endif
  110. ! ! other
  111. ! call Set( cvl_dat(region), status, used=.true. )
  112. ! call Set( cvh_dat(region), status, used=.true. )
  113. ! do iveg=1,nveg
  114. ! call Set( tv_dat(region,nveg), status, used=.true. )
  115. ! enddo
  116. ! call Set( ci_dat(region), status, used=.true. )
  117. ! call Set( sd_dat(region), status, used=.true. )
  118. ! call Set( swvl1_dat(region), status, used=.true. )
  119. ! call Set( t2m_dat(region), status, used=.true. )
  120. ! call Set( d2m_dat(region), status, used=.true. )
  121. ! call Set( ssr_dat(region), status, used=.true. )
  122. ! call Set( sshf_dat(region), status, used=.true. )
  123. ! call Set( slhf_dat(region), status, used=.true. )
  124. ! call Set( ewss_dat(region), status, used=.true. )
  125. ! call Set( nsss_dat(region), status, used=.true. )
  126. ! call Set( u10m_dat(region), status, used=.true. )
  127. ! call Set( v10m_dat(region), status, used=.true. )
  128. ! call Set( src_dat(region), status, used=.true. )
  129. ! call Set( albedo_dat(region), status, used=.true. )
  130. ! enddo
  131. !--------------------------------------------------
  132. ! ** Emissions
  133. !--------------------------------------------------
  134. #ifndef without_emission
  135. call Emission_Init( status )
  136. IF_NOTOK_RETURN(status=1)
  137. #endif /* EMISSIONS */
  138. !--------------------------------------------------
  139. ! ** Done
  140. !--------------------------------------------------
  141. status = 0
  142. END SUBROUTINE SOURCES_SINKS_INIT
  143. !EOC
  144. !------------------------------------------------------------------------------
  145. ! TM5 !
  146. !------------------------------------------------------------------------------
  147. !BOP
  148. !
  149. ! !IROUTINE: SOURCES_SINKS_DONE
  150. !
  151. ! !DESCRIPTION:
  152. !\\
  153. !\\
  154. ! !INTERFACE:
  155. !
  156. SUBROUTINE SOURCES_SINKS_DONE( status )
  157. !
  158. ! !USES:
  159. !
  160. #ifndef without_emission
  161. use emission, only : Emission_Done
  162. #endif
  163. !
  164. ! !OUTPUT PARAMETERS:
  165. !
  166. integer, intent(out) :: status
  167. !
  168. ! !REVISION HISTORY:
  169. !
  170. !EOP
  171. !------------------------------------------------------------------------------
  172. !BOC
  173. character(len=*), parameter :: rname = mname//'/Sources_Sinks_Done'
  174. ! --- begin --------------------------------
  175. #ifndef without_emission
  176. call Emission_Done( status )
  177. IF_NOTOK_RETURN(status=1)
  178. #endif
  179. status = 0
  180. END SUBROUTINE SOURCES_SINKS_DONE
  181. !EOC
  182. !------------------------------------------------------------------------------
  183. ! TM5 !
  184. !------------------------------------------------------------------------------
  185. !BOP
  186. !
  187. ! !IROUTINE: SS_MONTHLY_UPDATE
  188. !
  189. ! !DESCRIPTION: monthly (re)initialisation of sources/sinks
  190. !\\
  191. !\\
  192. ! !INTERFACE:
  193. !
  194. SUBROUTINE SS_MONTHLY_UPDATE( status )
  195. !
  196. ! !USES:
  197. !
  198. ! use GO, only : TrcFile, Init, Done, ReadRc
  199. ! use dims, only : nregions
  200. use dims, only : newmonth, idate, mlen, newsrun
  201. use dims, only : sec_day, sec_month, sec_year
  202. ! use dims, only : okdebug
  203. ! use dims, only : istart
  204. ! use dims, only : region_name
  205. ! use global_data, only : rcfile
  206. use datetime, only : calc_sm
  207. #ifndef without_emission
  208. use emission, only : declare_emission
  209. #endif
  210. !
  211. ! !OUTPUT PARAMETERS:
  212. !
  213. integer, intent(out) :: status
  214. !
  215. ! !REVISION HISTORY:
  216. ! 19 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  217. !
  218. ! !REMARKS:
  219. ! (1) routine is called at start and at beginning of each month
  220. !
  221. !EOP
  222. !------------------------------------------------------------------------------
  223. !BOC
  224. character(len=*), parameter :: rname = mname//'/ss_monthly_update'
  225. integer, parameter :: kr=31 ! standard unit to read auxiliary files
  226. ! --- begin ------------------------------------
  227. ! calculate some conversion factors related to time...
  228. call calc_sm( mlen, sec_day, sec_month, sec_year )
  229. ! Read monthly emissions
  230. #ifndef without_emission
  231. call declare_emission( status )
  232. IF_NOTOK_RETURN(status=1)
  233. #endif
  234. status = 0
  235. END SUBROUTINE SS_MONTHLY_UPDATE
  236. !EOC
  237. !------------------------------------------------------------------------------
  238. ! TM5 !
  239. !------------------------------------------------------------------------------
  240. !BOP
  241. !
  242. ! !IROUTINE: SS_AFTER_READ_METEO_UPDATE
  243. !
  244. ! !DESCRIPTION: subroutine that is called after reading new met fields (clouds,
  245. ! surface winds, etc.).
  246. ! In this routine, 'chemistry' fields that depend on these
  247. ! data are calculated. Called from modelIntegration/Proces_update.
  248. !\\
  249. !\\
  250. ! !INTERFACE:
  251. !
  252. SUBROUTINE SS_AFTER_READ_METEO_UPDATE( status )
  253. !
  254. ! !USES:
  255. !
  256. use dims, only : nregions, sec_month
  257. use tm5_distgrid, only : dgrid, Get_DistGrid
  258. !
  259. ! !OUTPUT PARAMETERS:
  260. !
  261. integer, intent(out) :: status
  262. !
  263. ! !REVISION HISTORY:
  264. ! 19 Mar 2012 - P. Le Sager - adapted for lon-lat MPI domain decomposition
  265. !
  266. ! !REMARKS:
  267. !
  268. !EOP
  269. !------------------------------------------------------------------------------
  270. !BOC
  271. character(len=*), parameter :: rname = 'ss_after_read_meteo_update'
  272. integer :: region, i1, j1
  273. ! --- begin ------------------------------------
  274. call goLabel()
  275. #ifndef without_emission
  276. ! TvN: nothing is done here in CO2 version
  277. #endif /* EMISSIONS */
  278. ! ok
  279. call goLabel()
  280. status = 0
  281. END SUBROUTINE SS_AFTER_READ_METEO_UPDATE
  282. !EOC
  283. !------------------------------------------------------------------------------
  284. ! TM5 !
  285. !------------------------------------------------------------------------------
  286. !BOP
  287. !
  288. ! !IROUTINE: SOURCES_SINKS_APPLY
  289. !
  290. ! !DESCRIPTION: this subroutine changes the tracer mass and its
  291. ! slopes by chemical sources.
  292. !\\
  293. !\\
  294. ! !INTERFACE:
  295. !
  296. SUBROUTINE SOURCES_SINKS_APPLY( region, tr, status )
  297. !
  298. ! !USES:
  299. !
  300. use GO, only : TDate
  301. #ifndef without_emission
  302. use emission, only: emission_apply
  303. #endif
  304. !
  305. ! !INPUT PARAMETERS:
  306. !
  307. integer, intent(in) :: region
  308. type(TDate) :: tr(2)
  309. !
  310. ! !OUTPUT PARAMETERS:
  311. !
  312. integer, intent(out) :: status
  313. !
  314. ! !REVISION HISTORY:
  315. !
  316. ! !REMARKS:
  317. ! - called each time step, during "source" step, by modelIntegration/do_steps
  318. !
  319. !EOP
  320. !------------------------------------------------------------------------------
  321. !BOC
  322. character(len=*), parameter :: rname = mname//'/Sources_sinks_apply'
  323. ! --- begin ----------------------------------
  324. #ifndef without_emission
  325. call emission_apply( region, status )
  326. IF_NOTOK_RETURN(status=1)
  327. #endif
  328. ! ok
  329. status = 0
  330. END SUBROUTINE SOURCES_SINKS_APPLY
  331. !EOC
  332. END MODULE SOURCES_SINKS