m7_delcoa.F90 41 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869
  1. #include "tm5.inc"
  2. #ifdef with_budgets
  3. SUBROUTINE m7_delcoa(kproma, kbdim, klev, paerml, &
  4. paernl, pm6rp, pa4delt, panew, &
  5. pa, pb, pbfract1, pbfract2, &
  6. pbfract5, pso4_5, pso4_6, pso4_7, ptime, &
  7. pprocess)
  8. #else
  9. SUBROUTINE m7_delcoa(kproma, kbdim, klev, paerml, &
  10. paernl, pm6rp, pa4delt, panew, &
  11. pa, pb, pbfract1, pbfract2, &
  12. pbfract5, pso4_5, pso4_6, pso4_7, ptime )
  13. #endif
  14. !
  15. ! Authors:
  16. ! ---------
  17. ! E. Vignati and J. Wilson, JRC/EI (original source) 09/2000
  18. ! P. Stier, MPI (f90-version, changes, comments) 2001
  19. !
  20. ! Version/History:
  21. ! ----------------
  22. ! equivalent to the version delco_n2 of the m7 boxmodel
  23. ! + use of the analytical solution
  24. !
  25. ! Purpose
  26. ! ---------
  27. ! This routine calculates changes in number concentration of
  28. ! each aerosol mode over the time step, due to coagulation with
  29. ! the current mode and all higher ones.
  30. !
  31. ! Method:
  32. ! -----------
  33. ! *delcoa* integrates for each mode dn/dt=c -a*n^2 -b*n over ztmst
  34. !
  35. ! The resulting particles are assumed to reside in the
  36. ! mode of highest mode of the pair of particles colliding.
  37. ! 1+1=>1 1+2=>2 1+3=>3, 2+2=>2 2+3=>3, 3+3=>3.
  38. ! zc is now non zero for mode 1 only (nucleation).
  39. ! All formation of higher mode particles is handled in dconc.
  40. !
  41. ! For climatological studies, 5 day accumulation mode concs are
  42. ! within a factor of 2 of the full model.
  43. !
  44. ! Interface
  45. ! -----------
  46. ! *m7_delcoa* is called from *m7_dnum*
  47. !
  48. ! Externals
  49. ! -----------
  50. ! none
  51. !
  52. ! USE mo_time_control, ONLY: time_step_len
  53. USE mo_aero_m7, ONLY: nmod, nsol, naermod, &
  54. iaiti, ibcki, iocki, isoaki, &
  55. ibcks, iocks, isoaks, ibcas, &
  56. iocas, isoaas, ibccs, ioccs, &
  57. isoacs, iduci, iduai, iacci, &
  58. icoai, iaits, isoans
  59. USE mo_aero_m7, ONLY: m7_coat
  60. #ifdef with_budgets
  61. Use M7_Data, only: nm7procs
  62. #endif
  63. IMPLICIT NONE
  64. !--- Parameter list:
  65. !
  66. ! paerml = total aerosol mass for each compound
  67. ! [molec. cm-3 for sulphate; ug m-3 for others]
  68. ! paernl = aerosol number for each mode [cm-3]
  69. ! pm6rp = mean mode actual radius (wet radius for soluble modes
  70. ! and dry radius for insoluble modes) [cm]
  71. ! pa4delt(:,:,:) = change in H2SO4 mass of the respective mode over one timstep
  72. ! due to:
  73. ! - nucleation of H2SO4 (calculated in m7_nuck)
  74. ! - coagulation (calculated in m7_concoag)
  75. ! panew = number of nucleated particles (during 1 timestep) [1]
  76. ! pa = unimodal coagulation coefficient (zcom(mod)) []
  77. ! pb = inter-modal coagulation with higher modes
  78. ! (zcom(mod) * n(jmod+1)) []
  79. ! pbfractx(:,:,y) = fraction of the total number of particles removed by
  80. ! coagulation from mode x that is moved to mode y+1 [1]
  81. ! pso4_x = mass of sulphate condensed on insoluble mode x [molec. cm-3]
  82. !
  83. !--- Local variables:
  84. !
  85. ! zansum = aerosol number in the respective mode [cm-3]
  86. ! zxxsum = aerosol mass for compound xx in the respective
  87. ! mode, e.g. xx = bc, oc, a4 (sulfate)
  88. ! [g cm-3 for bc,oc and molec. cm-3 for sulfate]
  89. ! zxxav = average mass of a sulfate particle in the respective
  90. ! mode [molecules]
  91. ! zxxavy = average mass of species xx in mode y []
  92. ! where xx is ss, du, bc, oc, or a4 for sulfate
  93. ! [molecules for sulfate and ug for others]
  94. ! zanli(:,:,:) = Number of particles moved by the inter-modal
  95. ! coagulation []
  96. ! zansq(:,:,:) = Number of particles moved by the intra-modal
  97. ! coagulation []
  98. ! zaernt(:,:,:) = New particle number n(t+dt) after the integration
  99. ! of the aerosol dynamics equation [cm-3]
  100. !--- Parameters:
  101. INTEGER :: kproma, kbdim, klev
  102. REAL :: ptime, time_step_len
  103. REAL :: paerml(kbdim,klev,naermod), paernl(kbdim,klev,nmod), &
  104. pa4delt(kbdim,klev,naermod), panew(kbdim,klev), &
  105. pm6rp(kbdim,klev,nmod)
  106. REAL :: pbfract1(kbdim,klev,nmod-1), pbfract2(kbdim,klev,nmod-1), &
  107. pbfract5(kbdim,klev,3)
  108. REAL :: pa(kbdim,klev,nmod), pb(kbdim,klev,nmod)
  109. REAL :: pso4_5(kbdim,klev), pso4_6(kbdim,klev), &
  110. pso4_7(kbdim,klev)
  111. #ifdef with_budgets
  112. Real :: pprocess(kbdim,klev,nm7procs)
  113. #endif
  114. ! Local variables:
  115. INTEGER :: jmod, jl, jk, kmod
  116. REAL :: za4av1(kbdim,klev), za4av2(kbdim,klev), &
  117. zbcav2(kbdim,klev), zocav2(kbdim,klev), &
  118. zbcav3(kbdim,klev), zocav3(kbdim,klev), &
  119. zbcav4(kbdim,klev), zocav4(kbdim,klev), &
  120. zbcav5(kbdim,klev), zocav5(kbdim,klev), &
  121. zduav6(kbdim,klev), zduav7(kbdim,klev), &
  122. zsoaav2(kbdim,klev), zsoaav3(kbdim,klev), &
  123. zsoaav4(kbdim,klev), zsoaav5(kbdim,klev), &
  124. zsoaav1(kbdim,klev)
  125. REAL :: zanli(kbdim,klev,nmod), zansq(kbdim,klev,nmod), &
  126. zaernt(kbdim,klev,nmod)
  127. REAL :: zm6rp(nmod), zcrtcst(nmod)
  128. ! Auxiliary variables:
  129. REAL :: zansum, zbcsum, zocsum, zsoasum, za4sum, za4av, &
  130. ztop, zbot, zatot, zanse, zanle, &
  131. ze1, zf1, zf2, zf3, zf4, zr1, &
  132. ztmst, zc
  133. REAL :: zamloss5, zamloss6, zamloss7, zanloss5, &
  134. zanloss6, zanloss7, ztloss, zbfofac, zms, &
  135. zbfnfac, zbftot, zaerni, zanytnt, &
  136. zanytni, zanytns, zanytnm, ztotn, &
  137. zaerns
  138. !--- m7_box:
  139. REAL :: zaernl_diff(kbdim,klev,nmod), zaerml_diff(kbdim,klev,naermod), &
  140. zaernl_0(kbdim,klev,nmod), zaerml_0(kbdim,klev,naermod)
  141. REAL :: zcrit_5, zcrit_6, zcrit_7
  142. zcrit_5=0.
  143. zcrit_6=0.
  144. zcrit_7=0.
  145. !--- END m7_box
  146. !--- 0) Initialisations: ------------------------------------------------
  147. time_step_len = ptime
  148. ztmst = time_step_len
  149. za4av = 0.
  150. za4av1(:,:) = 0.
  151. zsoaav1(:,:) = 0.
  152. za4av2(:,:) = 0.
  153. zbcav2(:,:) = 0.
  154. zocav2(:,:) = 0.
  155. zsoaav2(:,:) = 0.
  156. zbcav3(:,:) = 0.
  157. zocav3(:,:) = 0.
  158. zsoaav3(:,:) = 0.
  159. zbcav4(:,:) = 0.
  160. zocav4(:,:) = 0.
  161. zsoaav4(:,:) = 0.
  162. zbcav5(:,:) = 0.
  163. zocav5(:,:) = 0.
  164. zsoaav5(:,:) = 0.
  165. !--- m7_box:
  166. zaernl_0=paernl
  167. zaerml_0=paerml
  168. !--- END m7_box
  169. !--- 1) Insoluble modes
  170. !
  171. DO jk=1,klev
  172. DO jl=1,kproma
  173. !--- Dust modes insoluble:
  174. ! Calculate average mass (used in concoag)
  175. IF(paernl(jl,jk,iacci) > 0.0) THEN
  176. zduav6(jl,jk) = (paerml(jl,jk,iduai)*1.E-6) / paernl(jl,jk,iacci)
  177. ELSE
  178. zduav6(jl,jk)=0.
  179. END IF
  180. IF(paernl(jl,jk,icoai) > 0.0) THEN
  181. zduav7(jl,jk) = (paerml(jl,jk,iduci)*1.E-6) / paernl(jl,jk,icoai)
  182. ELSE
  183. zduav7(jl,jk)=0.
  184. END IF
  185. !--- Aitken mode insoluble:
  186. ! Only considered process:
  187. ! Coagulation and transfer from the insoluble aitken mode
  188. ! to the soluble aitken and accumulation modes.
  189. zansum=paernl(jl,jk,iaiti)
  190. zbcsum=paerml(jl,jk,ibcki)*1.e-6
  191. zocsum=paerml(jl,jk,iocki)*1.e-6
  192. zsoasum=paerml(jl,jk,isoaki)*1.e-6
  193. zaernt(jl,jk,iaiti)=zansum
  194. zanli(jl,jk,iaiti)=0.0
  195. zansq(jl,jk,iaiti)=0.0
  196. !--- Calculations only in presence of sufficient particles:
  197. IF (zansum > 1.E-10) THEN
  198. ! --- Average mass for a bc/oc/soa particle in the aitken mode [ug]:
  199. zbcav5(jl,jk)=zbcsum/zansum
  200. zocav5(jl,jk)=zocsum/zansum
  201. zsoaav5(jl,jk)=zsoasum/zansum
  202. !--- 1.1) Case of no coagulation:
  203. !
  204. ! (pa(jl,jk,iaiti) < 1.e-15 .AND. pb(jl,jk,iaiti) < 1.e-15)
  205. !
  206. ! => Nothing to be done
  207. !--- 1.2) Case with coagulation:
  208. IF (pa(jl,jk,iaiti) >= 1.e-15 .OR. pb(jl,jk,iaiti) >= 1.e-15) THEN
  209. !--- 1.2.1) Case of no inter-modal coagulation:
  210. ! dn/dt = -a*n**2 =>
  211. ! n(t) = n0/(1 + n0*a*(t-t0))
  212. IF (pb(jl,jk,iaiti) < 1.e-15) THEN
  213. zaernt(jl,jk,iaiti)=zansum/(1.0+zansum*pa(jl,jk,iaiti)*ztmst)
  214. zanli(jl,jk,iaiti)=0.0
  215. zansq(jl,jk,iaiti)=zansum-zaernt(jl,jk,iaiti)
  216. !--- 1.2.2) Case with inter- and intra-modal coagulation:
  217. ! dn/dt = -a*n**2 - b*n =>
  218. ! n(t) = (b*n0*exp(-b(t-t0)))/((n0*a)(1-exp(-b(t-t0)))+b)
  219. ELSE
  220. !--- Calculate n(t+dt):
  221. ze1=EXP(-pb(jl,jk,iaiti)*ztmst)
  222. ztop=pb(jl,jk,iaiti)*zansum*ze1
  223. zbot=zansum*pa(jl,jk,iaiti)*(1.0-ze1)+pb(jl,jk,iaiti)
  224. zaernt(jl,jk,iaiti)=ztop/zbot
  225. !--- Limit n(t+dt) to available particle in the mode:
  226. zaernt(jl,jk,iaiti)=MIN(zaernt(jl,jk,iaiti), zansum)
  227. !--- Total change in particle numbers of the mode due to coagulation:
  228. zatot=zansum-zaernt(jl,jk,iaiti)
  229. !--- Contribution of the intra-modal coagulation:
  230. zanse=zansum*zansum*pa(jl,jk,iaiti)
  231. !--- Contribution of the inter-modal coagulation:
  232. zanle=zansum*pb(jl,jk,iaiti)
  233. !--- Number of particles moved by the inter-modal coagulation:
  234. zanli(jl,jk,iaiti)=zatot*zanle/(zanse+zanle)
  235. !--- Number of particles moved by the intra-modal coagulation:
  236. zansq(jl,jk,iaiti)=zatot*zanse/(zanse+zanle)
  237. END IF
  238. !--- 1.2.3) Change masses of the insoluble aitken mode due to
  239. ! intra-modal coagulation and the coagulation with the
  240. ! nucleation mode (transfers to the soluble modes
  241. ! of the particles coagulating with the nucleation mode
  242. ! are done in m7_concoag):
  243. paerml(jl,jk,ibcki)=( zaernt(jl,jk,iaiti) + &
  244. zansq(jl,jk,iaiti) + &
  245. pbfract5(jl,jk,1)*zanli(jl,jk,iaiti) ) * &
  246. zbcav5(jl,jk)*1.e6
  247. paerml(jl,jk,iocki)=( zaernt(jl,jk,iaiti) + &
  248. zansq(jl,jk,iaiti) + &
  249. pbfract5(jl,jk,1)*zanli(jl,jk,iaiti) ) * &
  250. zocav5(jl,jk)*1.e6
  251. paerml(jl,jk,isoaki)=(zaernt(jl,jk,iaiti) + &
  252. zansq(jl,jk,iaiti) + &
  253. pbfract5(jl,jk,1)*zanli(jl,jk,iaiti) ) * &
  254. zsoaav5(jl,jk)*1.e6
  255. !--- 1.2.4) Change the numbers of the insoluble aitken mode due to
  256. ! intra-modal coagulation:
  257. paernl(jl,jk,iaiti)=zaernt(jl,jk,iaiti) + &
  258. pbfract5(jl,jk,1)*zanli(jl,jk,iaiti)
  259. !--- 1.2.5) Store changes in masses of compounds in the insoluble
  260. ! aitken mode due to inter-modal coagulation:
  261. ! (zanli(:,:,x) = total number of particles moved from mode x
  262. ! pbfract5(:,:,x)= fraction of the total number of particles
  263. ! moved from mode 5 that is moved to mode x )
  264. pa4delt(jl,jk,ibcks)=pbfract5(jl,jk,2)*zanli(jl,jk,iaiti)*zbcav5(jl,jk)*1.e6
  265. pa4delt(jl,jk,iocks)=pbfract5(jl,jk,2)*zanli(jl,jk,iaiti)*zocav5(jl,jk)*1.e6
  266. pa4delt(jl,jk,isoaks)=pbfract5(jl,jk,2)*zanli(jl,jk,iaiti)*zsoaav5(jl,jk)*1.e6
  267. pa4delt(jl,jk,ibcas)=pbfract5(jl,jk,3)*zanli(jl,jk,iaiti)*zbcav5(jl,jk)*1.e6
  268. pa4delt(jl,jk,iocas)=pbfract5(jl,jk,3)*zanli(jl,jk,iaiti)*zocav5(jl,jk)*1.e6
  269. pa4delt(jl,jk,isoaas)=pbfract5(jl,jk,3)*zanli(jl,jk,iaiti)*zsoaav5(jl,jk)*1.e6
  270. #ifdef with_budgets
  271. ! Here are some processes to notate
  272. #endif
  273. END IF
  274. END IF
  275. END DO
  276. END DO
  277. !
  278. !--- 2) Soluble modes: --------------------------------------------------
  279. !
  280. !CDIR unroll=5
  281. mode : DO jmod=1,nsol
  282. level : DO jk=1,klev
  283. longitude : DO jl=1,kproma
  284. !--- Nucleation mode:
  285. IF (jmod .EQ. 1) THEN
  286. zansum=paernl(jl,jk,jmod)+panew(jl,jk)
  287. za4sum=paerml(jl,jk,jmod)+pa4delt(jl,jk,1)
  288. zsoasum=paerml(jl,jk,isoans)*1.e-6+pa4delt(jl,jk,isoans)*1e-6
  289. !--- Others:
  290. ELSE
  291. zansum=paernl(jl,jk,jmod)
  292. za4sum=paerml(jl,jk,jmod)
  293. END IF
  294. IF (jmod.EQ.2) THEN
  295. zbcsum=paerml(jl,jk,ibcks)*1.e-6
  296. zocsum=paerml(jl,jk,iocks)*1.e-6
  297. zsoasum=paerml(jl,jk,isoaks)*1.e-6
  298. END IF
  299. IF (jmod.EQ.3) THEN
  300. zbcsum=paerml(jl,jk,ibcas)*1.e-6
  301. zocsum=paerml(jl,jk,iocas)*1.e-6
  302. zsoasum=paerml(jl,jk,isoaas)*1.e-6
  303. END IF
  304. IF (jmod.EQ.4) THEN
  305. zbcsum=paerml(jl,jk,ibccs)*1.e-6
  306. zocsum=paerml(jl,jk,ioccs)*1.e-6
  307. zsoasum=paerml(jl,jk,isoacs)*1.e-6
  308. END IF
  309. zaernt(jl,jk,jmod)=zansum
  310. zanli(jl,jk,jmod)=0.0
  311. zansq(jl,jk,jmod)=0.0
  312. !--- Calculations only in presence of sufficient particles:
  313. IF (zansum > 1.E-10) THEN
  314. za4av=za4sum/zansum
  315. IF (jmod.EQ.1) THEN
  316. za4av1(jl,jk)=za4av
  317. zsoaav1(jl,jk)=zsoasum/zansum
  318. ELSE IF (jmod.EQ.2) THEN
  319. zbcav2(jl,jk)=zbcsum/zansum
  320. zocav2(jl,jk)=zocsum/zansum
  321. zsoaav2(jl,jk)=zsoasum/zansum
  322. za4av2(jl,jk)=za4av
  323. ELSE IF (jmod.EQ.3) THEN
  324. zbcav3(jl,jk)=zbcsum/zansum
  325. zocav3(jl,jk)=zocsum/zansum
  326. zsoaav3(jl,jk)=zsoasum/zansum
  327. ELSE IF (jmod.EQ.4) THEN
  328. zbcav4(jl,jk)=zbcsum/zansum
  329. zocav4(jl,jk)=zocsum/zansum
  330. zsoaav4(jl,jk)=zsoasum/zansum
  331. END IF
  332. !--- 2.1) Case of no coagulation:
  333. !
  334. IF (pa(jl,jk,jmod) < 1.e-15 .AND. pb(jl,jk,jmod) < 1e-15) THEN
  335. !--- Nucleation in mode 1 only.
  336. ! Nothing to be done for other modes.
  337. IF(jmod.EQ.1) THEN
  338. paerml(jl,jk,jmod)=za4sum
  339. paernl(jl,jk,jmod)=zansum
  340. paerml(jl,jk,isoans)=zsoasum*1e6
  341. END IF
  342. !--- 2.2) Case with coagulation:
  343. ELSE
  344. !--- 2.2.1) Case of no nucleation:
  345. !--- Not Mode 1 or Nucleation rate below 1/s:
  346. IF ( (jmod .NE. 1) .OR. (panew(jl,jk)/ztmst < 1.0) ) THEN
  347. paernl(jl,jk,jmod)=zansum
  348. !--- 2.2.1a) Case of no inter-modal coagulation:
  349. ! dn/dt = -a*n**2 =>
  350. ! n(t) = n0/(1 + n0*a*(t-t0))
  351. IF (pb(jl,jk,jmod) < 1.e-15) THEN
  352. zaernt(jl,jk,jmod)=zansum/(1.0+zansum*pa(jl,jk,jmod)*ztmst)
  353. zanli(jl,jk,jmod)=0.0
  354. zansq(jl,jk,jmod)=zansum-zaernt(jl,jk,jmod)
  355. !--- 2.2.1b) Case with inter- and intra-modal coagulation:
  356. ! dn/dt = -a*n**2 - b*n =>
  357. ! n(t) = (b*n0*exp(-b(t-t0)))/((n0*a)(1-exp(-b(t-t0)))+b)
  358. ELSE
  359. !--- Calculate n(t+dt):
  360. ze1=EXP(-pb(jl,jk,jmod)*ztmst)
  361. ztop=pb(jl,jk,jmod)*zansum*ze1
  362. zbot=zansum*pa(jl,jk,jmod)*(1.0-ze1)+pb(jl,jk,jmod)
  363. zaernt(jl,jk,jmod)=ztop/zbot
  364. !--- Limit n(t+dt) to available particle in the mode:
  365. zaernt(jl,jk,jmod)=MIN(zaernt(jl,jk,jmod), zansum)
  366. !--- Total change in particle numbers of the mode due to coagulation:
  367. zatot=zansum-zaernt(jl,jk,jmod)
  368. !--- Contribution of the intra-modal coagulation:
  369. zanse=zansum*zansum*pa(jl,jk,jmod)
  370. !--- Contribution of the inter-modal coagulation:
  371. zanle=zansum*pb(jl,jk,jmod)
  372. !--- Number of particles moved by the inter-modal coagulation:
  373. zanli(jl,jk,jmod)=zatot*zanle/(zanse+zanle)
  374. !--- Number of particles moved by the intra-modal coagulation:
  375. zansq(jl,jk,jmod)=zatot*zanse/(zanse+zanle)
  376. END IF
  377. !--- 2.2.2) Case with nucleation:
  378. ELSE IF ( (jmod .EQ. 1) .AND. (panew(jl,jk)/ztmst >= 1.0) ) THEN
  379. !--- 2.2.2a) Nucleation, inter- and intra-modal coagulation:
  380. ! dn/dt = -a*n**2 - b*n + c =>
  381. ! n(t) = -(b/(2a)) +
  382. ! R/2a * [ ((1 - (-2ax0-b+R)/(+2ax0+b+R))exp(-Rt)) /
  383. ! ((1 + (-2ax0-b+R)/(+2ax0+b+R))exp(-Rt)) ]
  384. ! where: R=SQRT(b**2+4ac)
  385. !
  386. ! If b/=0 then always a/=0. The only case where a would be 0
  387. ! and b unequal zero is the case of no pre-existing particles
  388. ! in the nucleation mode but pre-existing particles in other
  389. ! modes. For this case a is calculated for an assumed radius
  390. ! of a critical cluster in m7_coaset.
  391. IF (pb(jl,jk,jmod) >= 1.E-15) THEN
  392. !--- Calculate n(t):
  393. !--- c:
  394. zc=panew(jl,jk)/ztmst
  395. !--- R:
  396. zf1=pb(jl,jk,jmod)*pb(jl,jk,jmod)+4.0*pa(jl,jk,jmod)*zc
  397. zr1=SQRT(zf1)
  398. !--- exp(-Rt):
  399. ze1=EXP(-zr1*ztmst)
  400. !--- 2ax0+b:
  401. zf2=2.0*pa(jl,jk,jmod)*paernl(jl,jk,jmod)+pb(jl,jk,jmod)
  402. !--- Term in squared bracket:
  403. zf3=ze1*(zr1-zf2)/(zr1+zf2)
  404. zf4=(1.0-zf3)/(1.0+zf3)
  405. !--- n(t):
  406. zaernt(jl,jk,jmod)=(zr1*zf4-pb(jl,jk,jmod))/2.0/pa(jl,jk,jmod)
  407. !--- Limit n(t+dt) to available particle in the mode:
  408. zaernt(jl,jk,jmod)=MIN(zaernt(jl,jk,jmod), zansum)
  409. !--- Total change in particle numbers of the mode due to coagulation:
  410. zatot=zansum-zaernt(jl,jk,jmod)
  411. !--- Contribution of the intra-modal coagulation:
  412. zanse=zansum*zansum*pa(jl,jk,jmod)
  413. !--- Contribution of the inter-modal coagulation:
  414. zanle=zansum*pb(jl,jk,jmod)
  415. !--- Number of particles moved by the inter-modal coagulation:
  416. zanli(jl,jk,jmod)=zatot*zanle/(zanse+zanle)
  417. !--- Number of particles moved by the intra-modal coagulation:
  418. zansq(jl,jk,jmod)=zatot*zanse/(zanse+zanle)
  419. !--- 2.2.2b) Nucleation and intra-modal coagulation:
  420. ! dn/dt = -a*n**2 - b*n + c with b=0 =>
  421. ! dn/dt = -a*n**2 + c =>
  422. ! n(t) = R/2a * [ ((1 - (-2ax0+R)/(+2ax0+R))exp(-Rt)) /
  423. ! ((1 + (-2ax0+R)/(+2ax0+R))exp(-Rt)) ]
  424. ! where: R=SQRT(4ac)
  425. !
  426. ! Can be shown to be equivalent to:
  427. !
  428. ! n(t) = R1*((x0+R1)/(x0-R1)+exp(-SQRT(-4ac)t)) /
  429. ! ((x0+R1)/(x0-R1)-exp(-SQRT(-4ac)t))
  430. ! where R1=SQRT(c/a)
  431. ELSE IF (pb(jl,jk,jmod) < 1.E-15) THEN
  432. !--- c:
  433. zc=panew(jl,jk)/ztmst
  434. !--- R1:
  435. zr1=SQRT(zc/pa(jl,jk,jmod))
  436. !--- exp(-Rt):
  437. ze1=EXP(-zr1*2.0*pa(jl,jk,jmod)*ztmst)
  438. !--- n(t):
  439. zf1=(paernl(jl,jk,jmod)+zr1)/(paernl(jl,jk,jmod)-zr1)
  440. ztop=zr1*(zf1+ze1)
  441. zbot=zf1-ze1
  442. IF (zbot < 1.E-15) THEN
  443. zaernt(jl,jk,jmod)=zansum
  444. ELSE
  445. zaernt(jl,jk,jmod)=ztop/zbot
  446. END IF
  447. !--- Limit n(t+dt) to available particle in the mode:
  448. zaernt(jl,jk,jmod)=MIN(zaernt(jl,jk,jmod), zansum)
  449. !--- Number of particles moved by the inter-modal coagulation:
  450. zanli(jl,jk,jmod)=0.0
  451. !--- Number of particles moved by the intra-modal coagulation:
  452. zansq(jl,jk,jmod)=zansum-zaernt(jl,jk,jmod)
  453. END IF
  454. END IF
  455. !---2.2.3 New bit for insoluble/souble coagulation
  456. !--- sum total insoluble+soluble paticles in mode jmod JJNW
  457. IF (jmod .EQ. 1 .AND. zanli(jl,jk,jmod)>0.0) THEN
  458. zaerni=paernl(jl,jk,iaiti)+paernl(jl,jk,iacci)+paernl(jl,jk,icoai)
  459. zaerns=zansum+paernl(jl,jk,iaits)
  460. ! zaerns=zansum
  461. ztotn=zaerns+zaerni
  462. IF (zaerns .gt. zaerni .and. zaerni .gt. 0.0) THEN
  463. ! calculate analytical solution no of mixed particles for coagulation
  464. ! between paernl(jl,jk,jmod) soluble particles and zaerni insouble of
  465. ! the same dimensions
  466. IF (zaerni .gt. 1.0) then
  467. zanytni=4.0*zaerni/((2.0+pa(jl,jk,jmod)*ztmst*ztotn)* &
  468. (2.0+pa(jl,jk,jmod)*ztmst*(ztotn-zaerni)))
  469. ELSE
  470. zanytni = 0.0
  471. ENDIF
  472. zanytnt=2.0*ztotn/(2.0+pa(jl,jk,jmod)*ztmst*ztotn)
  473. zanytns=4.0*zaerns/((2.0+pa(jl,jk,jmod)*ztmst*ztotn)* &
  474. (2.0+pa(jl,jk,jmod)*ztmst*(ztotn-zaerns)))
  475. zanytnm=zanytnt-(zanytni+zanytns)
  476. zanytnm=min(zanytnm,zaerni)
  477. zanytni=zaerni-zanytnm
  478. zanytns=zaernt(jl,jk,jmod)
  479. !CDIR UNROLL=7
  480. DO kmod=1,nmod
  481. zm6rp(kmod)=pm6rp(jl,jk,kmod)
  482. END DO
  483. CALL m7_coat(zm6rp,zcrtcst)
  484. zamloss5=paernl(jl,jk,5)/zaerni*zanytnm*zcrtcst(5)
  485. zanloss5=zamloss5/za4av
  486. zamloss6=paernl(jl,jk,6)/zaerni*zanytnm*zcrtcst(6)
  487. zanloss6=zamloss6/za4av
  488. zamloss7=paernl(jl,jk,7)/zaerni*zanytnm*zcrtcst(7)
  489. zanloss7=zamloss7/za4av
  490. ztloss=zanloss5+zanloss6+zanloss7
  491. zms=zansq(jl,jk,jmod)*0.95
  492. ztloss=min(ztloss,zansq(jl,jk,jmod)*0.95)
  493. zbfofac=zanli(jl,jk,jmod)/(zanli(jl,jk,jmod)+ztloss)
  494. zbfnfac=ztloss/(zanli(jl,jk,jmod)+ztloss)
  495. zanli(jl,jk,jmod)=zanli(jl,jk,jmod)+ztloss
  496. zansq(jl,jk,jmod)=zansq(jl,jk,jmod)-ztloss
  497. zbftot=0.0
  498. !CDIR UNROLL=7
  499. DO kmod=1,nmod
  500. IF(kmod>jmod) THEN
  501. pbfract1(jl,jk,kmod-jmod)=pbfract1(jl,jk,kmod-jmod)*zbfofac
  502. IF (kmod.GE.5) THEN
  503. pbfract1(jl,jk,kmod-jmod)=pbfract1(jl,jk,kmod-jmod)+ &
  504. zbfnfac*paernl(jl,jk,kmod)/zaerni
  505. END IF
  506. zbftot=zbftot+pbfract1(jl,jk,kmod-jmod)
  507. END IF
  508. END DO
  509. !CDIR UNROLL=7
  510. DO kmod=1,nmod
  511. IF (kmod>jmod) THEN
  512. pbfract1(jl,jk,kmod-jmod)=pbfract1(jl,jk,kmod-jmod)/zbftot
  513. END IF
  514. END DO
  515. END IF
  516. END IF
  517. !---- End of new inslouble/soluble caogulation routine JJNW
  518. !--- 2.3) Change masses and numbers of the respective modes to account-----------
  519. ! for intra-modal coagulation (zansq) and coagulation with
  520. ! higher modes (zaernt):
  521. !
  522. !--- 2.3.1) Change mass of the sulfur compounds:
  523. paerml(jl,jk,jmod)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*za4av
  524. !--- 2.3.2) Change mass of the carbon compounds:
  525. IF (jmod.EQ.1) THEN
  526. paerml(jl,jk,isoans)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zsoaav1(jl,jk)*1.e6
  527. ELSE IF (jmod.EQ.2) THEN
  528. paerml(jl,jk,ibcks)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zbcav2(jl,jk)*1.e6
  529. paerml(jl,jk,iocks)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zocav2(jl,jk)*1.e6
  530. paerml(jl,jk,isoaks)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zsoaav2(jl,jk)*1.e6
  531. ELSE IF (jmod.EQ.3) THEN
  532. paerml(jl,jk,ibcas)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zbcav3(jl,jk)*1.e6
  533. paerml(jl,jk,iocas)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zocav3(jl,jk)*1.e6
  534. paerml(jl,jk,isoaas)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zsoaav3(jl,jk)*1.e6
  535. ELSE IF (jmod.EQ.4) THEN
  536. paerml(jl,jk,ibccs)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zbcav4(jl,jk)*1.e6
  537. paerml(jl,jk,ioccs)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zocav4(jl,jk)*1.e6
  538. paerml(jl,jk,isoacs)=(zaernt(jl,jk,jmod)+zansq(jl,jk,jmod))*zsoaav4(jl,jk)*1.e6
  539. END IF
  540. !--- 2.3.3) Particle numbers:
  541. paernl(jl,jk,jmod)=zaernt(jl,jk,jmod)!@@@+zansq(jl,jk,jmod)/2.0
  542. !--- 2.4) Calculate changes in particle masses due to inter-modal --------------
  543. ! coagulation:
  544. !--- 2.4.1) Transfer of mass from mode 1 to other modes:
  545. IF (jmod .EQ. 1) THEN
  546. ! Mass from 1 to 2:
  547. pa4delt(jl,jk,2)=pbfract1(jl,jk,1)*zanli(jl,jk,1)*za4av
  548. pa4delt(jl,jk,isoaks)=pa4delt(jl,jk,isoaks)+pbfract1(jl,jk,1)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  549. ! Mass from 1 to 2 due to coag. with 5:
  550. pa4delt(jl,jk,2)=pa4delt(jl,jk,2)+pbfract1(jl,jk,4)*zanli(jl,jk,1)*za4av
  551. pa4delt(jl,jk,isoaks)=pa4delt(jl,jk,isoaks)+pbfract1(jl,jk,4)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  552. ! Mass from 1 to 3:
  553. pa4delt(jl,jk,3)=pbfract1(jl,jk,2)*zanli(jl,jk,1)*za4av
  554. pa4delt(jl,jk,isoaas)=pa4delt(jl,jk,isoaas)+pbfract1(jl,jk,2)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  555. ! Mass from 1 to 3 due to coag. with 6:
  556. pa4delt(jl,jk,3)=pa4delt(jl,jk,3)+pbfract1(jl,jk,5)*zanli(jl,jk,1)*za4av
  557. pa4delt(jl,jk,isoaas)=pa4delt(jl,jk,isoaas)+pbfract1(jl,jk,5)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  558. ! Mass from 1 to 4:
  559. pa4delt(jl,jk,4)=pbfract1(jl,jk,3)*zanli(jl,jk,1)*za4av
  560. pa4delt(jl,jk,isoacs)=pbfract1(jl,jk,3)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  561. ! Mass from 1 to 4 due to coag. with 7:
  562. pa4delt(jl,jk,4)=pa4delt(jl,jk,4)+pbfract1(jl,jk,6)*zanli(jl,jk,1)*za4av
  563. pa4delt(jl,jk,isoacs)=pa4delt(jl,jk,isoacs)+pbfract1(jl,jk,6)*zanli(jl,jk,1)*zsoaav1(jl,jk)*1.e6
  564. !--- 2.4.2) Transfer of mass from mode 2 to other modes:
  565. ELSE IF (jmod .EQ. 2) THEN
  566. ! Mass from 2 to 3:
  567. pa4delt(jl,jk,3)=pa4delt(jl,jk,3)+pbfract2(jl,jk,2)*zanli(jl,jk,2)*za4av
  568. pa4delt(jl,jk,ibcas)=pa4delt(jl,jk,ibcas)+ &
  569. pbfract2(jl,jk,2)*zanli(jl,jk,2)*zbcav2(jl,jk)*1.e6
  570. pa4delt(jl,jk,iocas)=pa4delt(jl,jk,iocas)+ &
  571. pbfract2(jl,jk,2)*zanli(jl,jk,2)*zocav2(jl,jk)*1.e6
  572. pa4delt(jl,jk,isoaas)=pa4delt(jl,jk,isoaas)+ &
  573. pbfract2(jl,jk,2)*zanli(jl,jk,2)*zsoaav2(jl,jk)*1.e6
  574. ! Mass from 2 to 3 due to coag. with 6:
  575. pa4delt(jl,jk,3)=pa4delt(jl,jk,3)+pbfract2(jl,jk,5)*zanli(jl,jk,2)*za4av
  576. pa4delt(jl,jk,ibcas)=pa4delt(jl,jk,ibcas)+ &
  577. pbfract2(jl,jk,5)*zanli(jl,jk,2)*zbcav2(jl,jk)*1.e6
  578. pa4delt(jl,jk,iocas)=pa4delt(jl,jk,iocas)+ &
  579. pbfract2(jl,jk,5)*zanli(jl,jk,2)*zocav2(jl,jk)*1.e6
  580. pa4delt(jl,jk,isoaas)=pa4delt(jl,jk,isoaas)+ &
  581. pbfract2(jl,jk,5)*zanli(jl,jk,2)*zsoaav2(jl,jk)*1.e6
  582. ! Mass from 2 to 4:
  583. pa4delt(jl,jk,4)=pa4delt(jl,jk,4)+pbfract2(jl,jk,3)*zanli(jl,jk,2)*za4av
  584. pa4delt(jl,jk,ibccs)=pa4delt(jl,jk,ibccs)+ &
  585. pbfract2(jl,jk,3)*zanli(jl,jk,2)*zbcav2(jl,jk)*1.E6
  586. pa4delt(jl,jk,ioccs)=pa4delt(jl,jk,ioccs)+ &
  587. pbfract2(jl,jk,3)*zanli(jl,jk,2)*zocav2(jl,jk)*1.E6
  588. pa4delt(jl,jk,isoacs)=pa4delt(jl,jk,isoacs)+ &
  589. pbfract2(jl,jk,3)*zanli(jl,jk,2)*zsoaav2(jl,jk)*1.E6
  590. ! Mass from 2 to 4 due to coag. with 7:
  591. pa4delt(jl,jk,4)=pa4delt(jl,jk,4)+pbfract2(jl,jk,6)*zanli(jl,jk,2)*za4av
  592. pa4delt(jl,jk,ibccs)=pa4delt(jl,jk,ibccs)+ &
  593. pbfract2(jl,jk,6)*zanli(jl,jk,2)*zbcav2(jl,jk)*1.E6
  594. pa4delt(jl,jk,ioccs)=pa4delt(jl,jk,ioccs)+ &
  595. pbfract2(jl,jk,6)*zanli(jl,jk,2)*zocav2(jl,jk)*1.E6
  596. pa4delt(jl,jk,isoacs)=pa4delt(jl,jk,isoacs)+ &
  597. pbfract2(jl,jk,6)*zanli(jl,jk,2)*zsoaav2(jl,jk)*1.E6
  598. ! Mass from 2 due to coagulation of 2 with 5 remains in 2:
  599. !
  600. !@@@ No effect as pbfract2(:,:,4)=0.!
  601. !@@@ (Not needed as it is assumed that 5 coagulates with 2
  602. !@@@ and therefor the masses in 2 remain unchanged!)
  603. pa4delt(jl,jk,2)=pa4delt(jl,jk,2)+pbfract2(jl,jk,4)*zanli(jl,jk,2)*za4av
  604. pa4delt(jl,jk,ibcks)=pa4delt(jl,jk,ibcks)+ &
  605. pbfract2(jl,jk,4)*zanli(jl,jk,2)*zbcav2(jl,jk)*1.E6
  606. pa4delt(jl,jk,iocks)=pa4delt(jl,jk,iocks)+ &
  607. pbfract2(jl,jk,4)*zanli(jl,jk,2)*zocav2(jl,jk)*1.E6
  608. pa4delt(jl,jk,isoaks)=pa4delt(jl,jk,isoaks)+ &
  609. pbfract2(jl,jk,4)*zanli(jl,jk,2)*zsoaav2(jl,jk)*1.E6
  610. END IF
  611. END IF
  612. END IF
  613. END DO longitude
  614. END DO level
  615. END DO mode
  616. !--- 3) Calculate transfer from the insoluble to the soluble modes: -------------------------
  617. #ifdef with_budgets
  618. CALL m7_concoag (kproma, kbdim, klev, &
  619. paerml, paernl, pm6rp, pa4delt, zanli, &
  620. za4av1, za4av2, zbcav5, zocav5, zsoaav5, &
  621. zduav6, zduav7, pso4_5, pso4_6, pso4_7, &
  622. pbfract1, pbfract2, &
  623. zcrit_5, zcrit_6, zcrit_7,pprocess ) !--- m7_box: Added for diagnostics
  624. #else
  625. CALL m7_concoag (kproma, kbdim, klev, &
  626. paerml, paernl, pm6rp, pa4delt, zanli, &
  627. za4av1, za4av2, zbcav5, zocav5, zsoaav5, &
  628. zduav6, zduav7, pso4_5, pso4_6, pso4_7, &
  629. pbfract1, pbfract2, &
  630. zcrit_5, zcrit_6, zcrit_7 ) !--- m7_box: Added for diagnostics
  631. #endif
  632. !--- 4) Final change of the aerosol masses due to nucleation, -------------------------------
  633. ! inter-modal coagulation and condensation on the insoluble modes:
  634. ! (Nucleation mode already done above.)
  635. DO jmod=2,naermod
  636. paerml(1:kproma,:,jmod)=paerml(1:kproma,:,jmod)+pa4delt(1:kproma,:,jmod)
  637. END DO
  638. !--- m7_box: Include diagnostics for conservation of numbers:
  639. DO jmod=1,nmod
  640. DO jk=1,klev
  641. DO jl=1,kproma
  642. SELECT CASE(jmod)
  643. CASE(1)
  644. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  645. (paernl(jl,jk,jmod) - panew(jl,jk) + &
  646. zansq(jl,jk,jmod) + zanli(jl,jk,jmod))
  647. CASE(2)
  648. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  649. (paernl(jl,jk,jmod) + &
  650. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) - &
  651. zcrit_5)
  652. CASE(3)
  653. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  654. (paernl(jl,jk,jmod) + &
  655. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) - &
  656. zcrit_6)
  657. CASE(4)
  658. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  659. (paernl(jl,jk,jmod) + &
  660. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) - &
  661. zcrit_7)
  662. CASE (5)
  663. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  664. (paernl(jl,jk,jmod) + &
  665. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) + &
  666. zcrit_5)
  667. CASE (6)
  668. zansq(jl,jk,jmod)=0.
  669. zanli(jl,jk,jmod)=0.
  670. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  671. (paernl(jl,jk,jmod) + &
  672. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) + &
  673. zcrit_6)
  674. CASE (7)
  675. zansq(jl,jk,jmod)=0.
  676. zanli(jl,jk,jmod)=0.
  677. zaernl_diff(jl,jk,jmod) = zaernl_0(jl,jk,jmod) - &
  678. (paernl(jl,jk,jmod) + &
  679. zansq(jl,jk,jmod) + zanli(jl,jk,jmod) + &
  680. zcrit_7)
  681. END SELECT
  682. zaerml_diff(jl,jk,jmod) = zaerml_0(jl,jk,jmod) - &
  683. (paerml(jl,jk,jmod)-panew(jl,jk)+zansq(jl,jk,jmod)+zanli(jl,jk,jmod))
  684. END DO
  685. END DO
  686. END DO
  687. #ifdef with_budgets
  688. pprocess(:,:,3) = zansq(:,:,1) ! Coagulation 1-1 N
  689. pprocess(:,:,4) = zanli(:,:,1)*pbfract1(:,:,1) ! The last 1 should be 2, but it is x+1 (clumsy), Coagulation 1-2 N
  690. pprocess(:,:,5) = zanli(:,:,1)*pbfract1(:,:,1)*za4av1 ! Coagulation 1-2 SU
  691. pprocess(:,:,67) = zanli(:,:,1)*pbfract1(:,:,1)*zsoaav1*1.e6 ! Coagulation 1-2 SOA
  692. pprocess(:,:,6) = zanli(:,:,1)*pbfract1(:,:,2) ! Coagulation 1-3 N
  693. pprocess(:,:,7) = zanli(:,:,1)*pbfract1(:,:,2)*za4av1 ! Coagulation 1-3 SU
  694. pprocess(:,:,68) = zanli(:,:,1)*pbfract1(:,:,2)*zsoaav1*1.e6 ! Coagulation 1-3 SOA
  695. pprocess(:,:,8) = zanli(:,:,1)*pbfract1(:,:,3) ! Coagulation 1-4 N
  696. pprocess(:,:,9) = zanli(:,:,1)*pbfract1(:,:,3)*za4av1 ! Coagulation 1-4 SU
  697. pprocess(:,:,69) = zanli(:,:,1)*pbfract1(:,:,3)*zsoaav1*1.e6 ! Coagulation 1-4 SOA
  698. pprocess(:,:,10) = zanli(:,:,1)*pbfract1(:,:,4) ! Coagulation 1-5 N
  699. pprocess(:,:,11) = zanli(:,:,1)*pbfract1(:,:,4)*za4av1 ! Coagulation 1-5 SU
  700. pprocess(:,:,70) = zanli(:,:,1)*pbfract1(:,:,4)*zsoaav1*1.e6 ! Coagulation 1-5 SOA
  701. pprocess(:,:,12) = zanli(:,:,1)*pbfract1(:,:,5) ! Coagulation 1-6 N
  702. pprocess(:,:,13) = zanli(:,:,1)*pbfract1(:,:,5)*za4av1 ! Coagulation 1-6 SU
  703. pprocess(:,:,71) = zanli(:,:,1)*pbfract1(:,:,5)*zsoaav1*1.e6 ! Coagulation 1-6 SOA
  704. pprocess(:,:,14) = zanli(:,:,1)*pbfract1(:,:,6) ! Coagulation 1-7 N
  705. pprocess(:,:,15) = zanli(:,:,1)*pbfract1(:,:,6)*za4av1 ! Coagulation 1-7 SU
  706. pprocess(:,:,72) = zanli(:,:,1)*pbfract1(:,:,6)*zsoaav1*1.e6 ! Coagulation 1-7 SOA
  707. pprocess(:,:,16) = zansq(:,:,2) ! Coagulation 2-2 N
  708. pprocess(:,:,17) = zanli(:,:,2)*pbfract2(:,:,2) ! Again, actually 3, Coagulation 2-3 N
  709. pprocess(:,:,18) = zanli(:,:,2)*pbfract2(:,:,2)*za4av2 ! Coagulation 2-3 SU
  710. pprocess(:,:,19) = zanli(:,:,2)*pbfract2(:,:,2)*zbcav2*1.e6 ! Coagulation 2-3 BC
  711. pprocess(:,:,20) = zanli(:,:,2)*pbfract2(:,:,2)*zocav2*1.e6 ! Coagulation 2-3 OC
  712. pprocess(:,:,73) = zanli(:,:,2)*pbfract2(:,:,2)*zsoaav2*1.e6 ! Coagulation 2-3 SOA
  713. pprocess(:,:,21) = zanli(:,:,2)*pbfract2(:,:,3) ! Coagulation 2-4 N
  714. pprocess(:,:,22) = zanli(:,:,2)*pbfract2(:,:,3)*za4av2 ! Coagulation 2-4 SU
  715. pprocess(:,:,23) = zanli(:,:,2)*pbfract2(:,:,3)*zbcav2*1.e6 ! Coagulation 2-4 BC
  716. pprocess(:,:,24) = zanli(:,:,2)*pbfract2(:,:,3)*zocav2*1.e6 ! Coagulation 2-4 OC
  717. pprocess(:,:,74) = zanli(:,:,2)*pbfract2(:,:,3)*zsoaav2*1.e6 ! Coagulation 2-4 SOA
  718. pprocess(:,:,25) = zanli(:,:,5)*pbfract5(:,:,2) ! Here, the 2 is good. Coagulation 2-5 N
  719. pprocess(:,:,26) = zanli(:,:,5)*pbfract5(:,:,2)*zbcav5*1.e6 ! Coagulation 2-5 BC
  720. pprocess(:,:,27) = zanli(:,:,5)*pbfract5(:,:,2)*zocav5*1.e6 ! Coagulation 2-5 OC
  721. pprocess(:,:,75) = zanli(:,:,5)*pbfract5(:,:,2)*zsoaav5*1.e6 ! Coagulation 2-5 SOA
  722. pprocess(:,:,28) = zanli(:,:,2)*pbfract2(:,:,5) ! Coagulation 2-6 N
  723. pprocess(:,:,29) = zanli(:,:,2)*pbfract2(:,:,5)*za4av2 ! Coagulation 2-6 SU
  724. pprocess(:,:,30) = zanli(:,:,2)*pbfract2(:,:,5)*zbcav2*1.e6 ! Coagulation 2-6 BC
  725. pprocess(:,:,31) = zanli(:,:,2)*pbfract2(:,:,5)*zocav2*1.e6 ! Coagulation 2-6 OC
  726. pprocess(:,:,76) = zanli(:,:,2)*pbfract2(:,:,5)*zsoaav2*1.e6 ! Coagulation 2-6 SOA
  727. pprocess(:,:,32) = zanli(:,:,2)*pbfract2(:,:,6) ! Coagulation 2-7 N
  728. pprocess(:,:,33) = zanli(:,:,2)*pbfract2(:,:,6)*za4av2 ! Coagulation 2-7 SU
  729. pprocess(:,:,34) = zanli(:,:,2)*pbfract2(:,:,6)*zbcav2*1.e6 ! Coagulation 2-7 BC
  730. pprocess(:,:,35) = zanli(:,:,2)*pbfract2(:,:,6)*zocav2*1.e6 ! Coagulation 2-7 OC
  731. pprocess(:,:,77) = zanli(:,:,2)*pbfract2(:,:,6)*zsoaav2*1.e6 ! Coagulation 2-7 SOA
  732. pprocess(:,:,36) = zansq(:,:,3) ! Coagulation 3-3 N
  733. pprocess(:,:,37) = zanli(:,:,5)*pbfract5(:,:,3) ! Coagulation 3-5 N
  734. pprocess(:,:,38) = zanli(:,:,5)*pbfract5(:,:,3)*zbcav5*1.e6 ! Coagulation 3-5 BC
  735. pprocess(:,:,39) = zanli(:,:,5)*pbfract5(:,:,3)*zocav5*1.e6 ! Coagulation 3-5 OC
  736. pprocess(:,:,78) = zanli(:,:,5)*pbfract5(:,:,3)*zsoaav5*1.e6 ! Coagulation 3-5 SOA
  737. pprocess(:,:,40) = zansq(:,:,5) ! Coagulation 5-5 N
  738. #endif
  739. !AJS: this is only for debugging ?
  740. !WRITE(77,*) zaernl_diff
  741. END SUBROUTINE m7_delcoa