-
Notifications
You must be signed in to change notification settings - Fork 26
/
Copy pathmo_carbch.F90
446 lines (394 loc) · 17.4 KB
/
mo_carbch.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
! Copyright (C) 2002 S. Legutke, P. Wetzel
! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger
!
! This file is part of BLOM/iHAMOCC.
!
! BLOM is free software: you can redistribute it and/or modify it under the
! terms of the GNU Lesser General Public License as published by the Free
! Software Foundation, either version 3 of the License, or (at your option)
! any later version.
!
! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
! more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with BLOM. If not, see https://www.gnu.org/licenses/.
module mo_carbch
!*************************************************************************************************
! Variables for inorganic carbon cycle (declaration and memory allocation)
!
! S.Legutke, *MPI-MaD, HH* 31.10.01
!
! Modified
! Patrick Wetzel *MPI-Met, HH* 16.04.02
! - new: atm, atdifv, suppco2
! - changed: chemc(:,:,:) to chemcm(:,:,:,:)
! - new: bgcmean(:,:,:,:)
! J. Schwinger *UiB-GfI, Bergen* 04.05.12
! - added initialisation of all vars after allocation
! J.Schwinger, *Uni Research, Bergen* 2018-04-12
! - moved accumulation of all output fields to seperate subroutine,
! new global fields for output defined here
! - added OmegaA
!*************************************************************************************************
implicit none
private
! Routines
public :: alloc_mem_carbch ! Allocate memory for inorganic carbon variables
! Module variables
real, dimension (:,:,:,:), allocatable, public :: ocetra
real, dimension (:,:,:), allocatable, public :: atm
real, dimension (:,:,:), allocatable, public :: atmflx
real, dimension (:,:), allocatable, public :: ndepnoyflx
real, dimension (:,:), allocatable, public :: ndepnhxflx
real, dimension (:,:), allocatable, public :: oalkflx
real, dimension (:,:,:), allocatable, public :: rivinflx
real, dimension (:,:,:), allocatable, public :: co3
real, dimension (:,:,:), allocatable, public :: co2star
real, dimension (:,:,:), allocatable, public :: hi
real, dimension (:,:,:), allocatable, public :: omegaa
real, dimension (:,:,:), allocatable, public :: omegac
real, dimension (:,:,:), allocatable, public :: keqb
real, dimension (:,:,:), allocatable, public :: satoxy
real, dimension (:,:), allocatable, public :: satn2o
real, dimension (:,:), allocatable, public :: pn2om
real, dimension (:,:), allocatable, public :: pnh3
real, dimension (:,:), allocatable, public :: atdifv
real, dimension (:,:), allocatable, public :: suppco2
real, dimension (:,:,:), allocatable, public :: sedfluxo
real, dimension (:,:,:), allocatable, public :: sedfluxb
real, dimension (:,:), allocatable, public :: fco2
real, dimension (:,:), allocatable, public :: pco2
real, dimension (:,:), allocatable, public :: xco2
real, dimension (:,:), allocatable, public :: pco2_gex
real, dimension (:,:), allocatable, public :: kwco2sol
real, dimension (:,:), allocatable, public :: kwco2a
real, dimension (:,:), allocatable, public :: co2sol
real, dimension (:,:), allocatable, public :: co2fxd
real, dimension (:,:), allocatable, public :: co2fxu
real, dimension (:,:), allocatable, public :: co213fxd
real, dimension (:,:), allocatable, public :: co213fxu
real, dimension (:,:), allocatable, public :: co214fxd
real, dimension (:,:), allocatable, public :: co214fxu
real, dimension (:,:), allocatable, public :: natpco2
real, dimension (:,:,:), allocatable, public :: nathi
real, dimension (:,:,:), allocatable, public :: natco3
real, dimension (:,:,:), allocatable, public :: natomegaa
real, dimension (:,:,:), allocatable, public :: natomegac
real, public :: atm_co2
real, public :: atm_cfc11_nh, atm_cfc11_sh
real, public :: atm_cfc12_nh, atm_cfc12_sh
real, public :: atm_sf6_nh, atm_sf6_sh
contains
subroutine alloc_mem_carbch(kpie,kpje,kpke)
!--------------------------------------------
! Allocate variables in this module
!--------------------------------------------
use mod_xc, only: mnproc
use mo_control_bgc, only: io_stdo_bgc
use mo_param1_bgc, only: nocetra,npowtra,nsedtra,natm,nriv
use mo_control_bgc, only: use_natDIC,use_cisonew,use_extNcycle
integer, intent(in) :: kpie
integer, intent(in) :: kpje
integer, intent(in) :: kpke
! Local variables
integer :: errstat
if (mnproc.eq.1) then
write(io_stdo_bgc,*)' '
write(io_stdo_bgc,*)'***************************************************'
write(io_stdo_bgc,*)'Memory allocation for carbon chemistry module :'
write(io_stdo_bgc,*)' '
endif
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable ocetra ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
write(io_stdo_bgc,*)'Forth dimension : ',nocetra
endif
allocate (ocetra(kpie,kpje,kpke,nocetra),stat=errstat)
if(errstat.ne.0) stop 'not enough memory ocetra'
ocetra(:,:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable hi ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (hi(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory hi'
hi(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable co3 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (co3(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co3'
co3(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable co2star ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (co2star(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co2star'
co2star(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable OmegaA, OmegaC ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (OmegaA(kpie,kpje,kpke),stat=errstat)
allocate (OmegaC(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory OmegaA, OmegaC'
OmegaA(:,:,:) = 0.0
OmegaC(:,:,:) = 0.0
if (use_natDIC) then
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable natpco2 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (natpco2(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory natpco2'
natpco2(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable nathi ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (nathi(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory nathi'
nathi(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable natco3 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (natco3(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory natco3'
natco3(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable natOmegaA, natOmegaC ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (natOmegaA(kpie,kpje,kpke),stat=errstat)
allocate (natOmegaC(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory natOmegaA, natOmegaC'
natOmegaA(:,:,:) = 0.0
natOmegaC(:,:,:) = 0.0
endif
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable sedfluxo ..'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',npowtra
endif
allocate (sedfluxo(kpie,kpje,npowtra),stat=errstat)
if(errstat.ne.0) stop 'not enough memory sedfluxo'
sedfluxo(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable sedfluxb ..'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',nsedtra
endif
allocate (sedfluxb(kpie,kpje,nsedtra),stat=errstat)
if(errstat.ne.0) stop 'not enough memory sedfluxb'
sedfluxb(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable satn2o ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (satn2o(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory satn2o'
satn2o(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable pn2om ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (pn2om(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory pn2om'
pn2om(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable keqb ...'
write(io_stdo_bgc,*)'First dimension : ',11
write(io_stdo_bgc,*)'Second dimension : ',kpie
write(io_stdo_bgc,*)'Third dimension : ',kpje
endif
allocate (keqb(11,kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory keqb'
keqb(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable satoxy ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',kpke
endif
allocate (satoxy(kpie,kpje,kpke),stat=errstat)
if(errstat.ne.0) stop 'not enough memory satoxy'
satoxy(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable atm ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',natm
endif
allocate (atm(kpie,kpje,natm),stat=errstat)
if(errstat.ne.0) stop 'not enough memory atm'
atm(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable atmflx ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',natm
endif
allocate (atmflx(kpie,kpje,natm),stat=errstat)
if(errstat.ne.0) stop 'not enough memory atmflx'
atmflx(:,:,:) = 0.0
! Allocate field to hold N-deposition fluxes per timestep for
! inventory calculations and output
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable ndepnoyflx ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (ndepnoyflx(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory ndepfnoylx'
ndepnoyflx(:,:) = 0.0
! Allocate field to hold OA alkalinity fluxes per timestep for
! inventory calculations and output
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (oalkflx(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory oalkflx'
oalkflx(:,:) = 0.0
! Allocate field to hold riverine fluxes per timestep for inventory calculations
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable rivinflx ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
write(io_stdo_bgc,*)'Third dimension : ',nriv
endif
allocate(rivinflx(kpie,kpje,nriv),stat=errstat)
if(errstat.ne.0) stop 'not enough memory rivinflx'
rivinflx(:,:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable fco2 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (fco2(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory fco2'
fco2(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable pco2 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (pco2(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory pco2'
pco2(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable xco2 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (xco2(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory xco2'
xco2(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable pco2_gex ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (pco2_gex(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory pco2_gex'
pco2_gex(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable kwco2a ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (kwco2a(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory kwco2a'
kwco2a(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable kwco2sol ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (kwco2sol(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu'
kwco2sol(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable co2sol ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (co2sol(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co2sold'
co2sol(:,:) = 0.0
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable co2fxd, co2fxu ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (co2fxd(kpie,kpje),stat=errstat)
allocate (co2fxu(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu'
co2fxd(:,:) = 0.0
co2fxu(:,:) = 0.0
if (use_cisonew) then
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable co213fxd,..., co214fxu ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (co213fxd(kpie,kpje),stat=errstat)
allocate (co213fxu(kpie,kpje),stat=errstat)
allocate (co214fxd(kpie,kpje),stat=errstat)
allocate (co214fxu(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory co213fxd,..., co214fxu'
co213fxd(:,:) = 0.0
co213fxu(:,:) = 0.0
co214fxd(:,:) = 0.0
co214fxu(:,:) = 0.0
endif
if (use_extNcycle) then
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable pnh3 ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (pnh3(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory pnh3'
pnh3(:,:) = 0.0
! Allocate field to hold N-deposition NHx fluxes per timestep for inventory caluclations
if (mnproc.eq.1) then
write(io_stdo_bgc,*)'Memory allocation for variable ndepnhxflx ...'
write(io_stdo_bgc,*)'First dimension : ',kpie
write(io_stdo_bgc,*)'Second dimension : ',kpje
endif
allocate (ndepnhxflx(kpie,kpje),stat=errstat)
if(errstat.ne.0) stop 'not enough memory ndepnhxflx'
ndepnhxflx(:,:) = 0.0
endif
end subroutine alloc_mem_carbch
!*************************************************************************************************
end module mo_carbch