New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bio_medusa_mod.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.

File size: 23.5 KB
Line 
1MODULE bio_medusa_mod
2   !!======================================================================
3   !!                      ***  MODULE  bio_medusa_mod  ***
4   !! MEDUSA variables   :  module for MEDUSA variables which are shared
5   !!                       across subroutines
6   !!======================================================================
7   !! History :
8   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
9   !!   -   ! 2017-08 (A. Yool)            Slow detritus, ML-avg chl variables
10   !!   -   ! 2018-08 (A. Yool)            add OMIP preindustrial DIC
11   !!   -   ! 2018-10 (A. Yool)            Add air-sea DMS flux
12   !!----------------------------------------------------------------------
13#if defined key_medusa
14   !!----------------------------------------------------------------------
15   !!   'key_medusa'                                           MEDUSA
16   !!----------------------------------------------------------------------
17   !! Variable conventions
18   !!----------------------------------------------------------------------
19   !!
20   !! names: z*** - state variable
21   !!        f*** - function (or temporary variable used in part of a function)
22   !!        b*** - right-hand part (sources and sinks)
23   !!        i*** - integer variable (usually used in yes/no flags)
24   !!----------------------------------------------------------------------
25   USE par_kind,          ONLY: wp
26   
27   USE yomhook, ONLY: lhook, dr_hook
28   USE parkind1, ONLY: jprb, jpim
29
30   IMPLICIT NONE
31   PUBLIC
32
33   PUBLIC   bio_medusa_alloc     ! called by trcini.F90
34
35   !! model state variables
36   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zchn,zchd,zphn,zphd,zpds,zzmi
37   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zzme,zdet,zdtc,zdin,zsil,zfer
38# if defined key_roam
39   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdic, zalk, zoxy
40   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmp, zsal
41# endif
42# if defined key_mocsy
43   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpho
44# endif
45# if defined key_omip_dic
46   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zomd
47# endif
48
49   !! integrated source and sink terms
50   REAL(wp) ::    b0
51
52   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,fprn,frn
53   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fprd,frd
54
55   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn,fjlim_pd
56   !! AXY (16/07/09): add in Eppley curve functionality
57   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_T,xvpnT,xvpdT
58
59   !! AXY (16/05/11): per Katya's prompting, add in new T-dependence
60   !!                 for phytoplankton growth only (i.e. no change
61   !!                 for remineralisation)
62   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_Q10
63   !! AXY (01/03/10): add in mixed layer PP diagnostics
64   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn_ml,fprd_ml
65   !! AXY (16/08/17): add in mixed layer chlorophyll diagnostic
66   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fchl_ml
67   !!
68   !! nutrient limiting factors
69   !! N and Fe (renaming ffln to ffln2 to avoid conflict with
70   !! ffln in module sms_medusa - marc 25/4/17)
71   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnln,ffln2
72   !! N, Fe and Si
73   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnld,ffld,fsld,fsld2
74   !!
75   !! silicon cycle
76   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,fprds,fsdiss
77
78   !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme
79   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffetop,ffebot,ffescav
80   !! Variable for iron-ligand system
81   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: xFree
82
83   !! Microzooplankton grazing
84   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmipn,fgmid,fgmidc
85   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi
86   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmigrow,fmiexcr,fmiresp
87   !!
88   !! Mesozooplankton grazing
89   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepn,fgmepd
90   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepds,fgmezmi,fgmed,fgmedc
91   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme
92   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmegrow,fmeexcr,fmeresp
93   !!
94   !! mortality/Remineralisation
95   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn,fdpd,fdpds,fdzmi,fdzme,fdd
96# if defined key_roam
97   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fddc
98# endif
99   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2
100   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslown, fslowc
101   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslownflux, fslowcflux
102   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregen,fregensi
103   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfast,fregenfastsi
104# if defined key_roam
105   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfastc
106# endif
107   !!
108   !! AXY (08/08/17): sinking of detritus moved here
109   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::    fslowsink, fslowgain, fslowloss
110# if defined key_roam
111   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::    fslowsinkc, fslowgainc, fslowlossc
112# endif
113   !!
114   !! Particle flux
115   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1
116   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn,ftempsi,ftempfe
117   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc,ftempca
118   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminn,freminsi,freminfe
119   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminc,freminca
120   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastn,ffastsi,ffastfe
121   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastc,ffastca
122   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsedn,fsedsi,fsedfe,fsedc,fsedca
123   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd
124
125   !! AXY (08/07/11): fate of fast detritus reaching the seafloor
126   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffast2slown,ffast2slowc
127
128   !! water column nutrient and flux integrals
129   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_n,ftot_si,ftot_fe
130   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fflx_n,fflx_si,fflx_fe
131   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_n,fifd_si,fifd_fe
132   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_n,fofd_si,fofd_fe
133# if defined key_roam
134   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_c,ftot_a,ftot_o2
135   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fflx_c,fflx_a,fflx_o2
136! I don't think fifd_a, fifd_o2, fofd_a or fofd_o2 are used - marc 11/5/17
137!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_c,fifd_a,fifd_o2
138!   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_c,fofd_a,fofd_o2
139   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fifd_c
140   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fofd_c
141# endif
142
143   !! Zooplankton grazing integrals
144   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fzmi_i,fzmi_o,fzme_i,fzme_o
145
146   !! Limitation term temporary variables
147   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_pn,ftot_pd
148   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_zmi,ftot_zme,ftot_det,ftot_dtc
149
150   !! use biological fluxes (1) or not (0)
151   INTEGER  ::    ibio_switch
152   !!
153   !! diagnose fluxes (should only be used in 1D runs)
154   INTEGER                               :: idf, idfval
155
156   !! Nitrogen and silicon production and consumption
157   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnit_prod,fnit_cons
158   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsil_prod,fsil_cons
159
160# if defined key_roam
161   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_xco2a
162   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ph,f_pco2w,f_h2co3
163   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_hco3,f_co3,f_co2flux
164   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_TDIC,f_TALK,f_dcf,f_henry
165   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pp0
166   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_kw660,f_o2flux,f_o2sat
167   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_omcal,f_omarg
168
169   !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen
170   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2atm
171
172#  if defined key_omip_dic
173   !! AXY (06/08/18): OMIP PI DIC additions
174   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_xco2a
175   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_ph,f_pi_pco2w,f_pi_h2co3
176   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_hco3,f_pi_co3,f_pi_co2flux
177   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_TDIC
178   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_omcal,f_pi_omarg
179   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_pco2atm
180#  endif
181   
182   !! Carbon, alkalinity production and consumption
183   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fcomm_resp
184   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fcar_prod,fcar_cons
185
186   !! Oxygen production and consumption (and non-consumption)
187   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: foxy_prod,foxy_cons,foxy_anox
188
189   !! Add DMS in MEDUSA for UKESM1 model
190   REAL(wp)                              :: dms_surf,dms_andm,dms_flux
191   !! AXY (13/03/15): add in other DMS calculations
192   REAL(wp)                              :: dms_andr,dms_simo,dms_aran,dms_hall
193   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_nlim, dms_wtkn
194# endif
195
196   !! Benthic fluxes
197   INTEGER  ::    ibenthic
198   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_sbenin_n,f_sbenin_fe,f_sbenin_c
199   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fbenin_n,f_fbenin_fe,f_fbenin_si
200   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fbenin_c,f_fbenin_ca
201   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_n,f_benout_fe,f_benout_si 
202   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_c,f_benout_ca
203
204   !! Benthic fluxes of CaCO3 that shouldn't happen because of lysocline
205   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_benout_lyso_ca
206
207   !! riverine fluxes
208   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_runoff,f_riv_n,f_riv_si
209   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_c,f_riv_alk
210   !! AXY (19/07/12): variables for local riverine fluxes to handle
211   !! inputs below surface
212   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_n,f_riv_loc_si
213   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_c, f_riv_loc_alk
214
215   !! Jpalm -- 11-10-2015 -- adapt diag to iom_use
216   !! 2D var for diagnostics.
217   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn2d, fdpn2d, fprd2d, fdpd2d
218   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprds2d, fsdiss2d, fgmipn2d
219   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmid2d, fdzmi2d, fgmepn2d
220   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepd2d, fgmezmi2d, fgmed2d
221   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdzme2d, fslown2d, fdd2d
222   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffetop2d, ffebot2d, ffescav2d
223   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjln2d, fnln2d, ffln2d, fjld2d
224   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fnld2d, ffld2d, fsld2d2
225   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsld2d, fregen2d, fregensi2d
226   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn2d, ftempsi2d, ftempfe2d
227   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc2d, ftempca2d, freminn2d
228   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminsi2d, freminfe2d
229   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: freminc2d, freminca2d
230   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
231# if defined key_roam
232   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastca2d, rivn2d, rivsi2d
233   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: rivc2d, rivalk2d, fslowc2d
234   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdpn22d, fdpd22d, fdzmi22d
235   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdzme22d, zimesn2d, zimesd2d
236   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zimesc2d, zimesdc2d, ziexcr2d
237   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ziresp2d, zigrow2d, zemesn2d
238   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zemesd2d, zemesc2d, zemesdc2d
239   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zeexcr2d, zeresp2d, zegrow2d
240   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: mdetc2d, gmidc2d, gmedc2d
241   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2a2d, f_pco2w2d, f_co2flux2d
242   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_TDIC2d, f_TALK2d, f_kw6602d
243   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pp02d, f_o2flux2d, f_o2sat2d
244   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_andr2d, dms_simo2d, dms_aran2d
245   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_hall2d, dms_andm2d, dms_surf2d
246   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_flux2d
247   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: iben_n2d, iben_fe2d, iben_c2d
248   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: iben_si2d, iben_ca2d, oben_n2d
249   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: oben_fe2d, oben_c2d, oben_si2d
250   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: oben_ca2d, sfr_ocal2d
251   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: sfr_oarg2d, lyso_ca2d 
252   !! AXY (23/11/16): extra MOCSY diagnostics
253   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d
254   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnrhosw_2d, f_ocnschco2_2d
255   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnkwco2_2d
256   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocnk0_2d, f_co2starair_2d
257   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_ocndpco2_2d
258#  if defined key_omip_dic
259   !! AXY (06/08/18): OMIP PI DIC additions
260   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_xco2a_2d, f_pi_fco2w_2d, f_pi_fco2a_2d
261   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_co2starair_2d
262   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_ocndpco2_2d
263   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_pco2a_2d, f_pi_pco2w_2d, f_pi_co2flux_2d
264   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_TDIC_2d
265   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_ph_2d, f_pi_omcal_2d, f_pi_omarg_2d
266   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pi_h2co3_2d, f_pi_hco3_2d, f_pi_co3_2d
267#  endif
268# endif
269   !!
270   !! 3D var for diagnostics.
271   REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn
272   !!
273# if defined key_roam
274   !! AXY (04/11/16)
275   !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef
276   !! for simplicity)
277   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgco2,intdissic,intdissin
278   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: intdissisi,inttalk,o2min,zo2min
279   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fbddtalk,fbddtdic,fbddtdife
280   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fbddtdin,fbddtdisi
281#  if defined key_omip_dic
282   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: pi_fgco2
283#  endif
284   !!
285   !! 3D var for new CMIP6 diagnostics
286   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tppd3
287   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: bddtalk3,bddtdic3,bddtdife3
288   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: bddtdin3, bddtdisi3
289   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: fd_nit3,fd_sil3,fd_car3,fd_cal3
290   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: co33,co3satarag3
291   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: co3satcalc3,dcalc3
292   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: expc3,expn3
293   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: fediss3,fescav3
294   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: migrazp3,migrazd3,megrazp3
295   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: megrazd3, megrazz3
296   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: o2sat3,pbsi3,pcal3,remoc3
297   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pnlimj3,pnlimn3,pnlimfe3
298   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: pdlimj3,pdlimn3,pdlimfe3,pdlimsi3
299# endif
300   !!----------------------------------------------------------------------
301   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010)
302   !! $Id$
303   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
304   !!----------------------------------------------------------------------
305CONTAINS
306
307   INTEGER FUNCTION bio_medusa_alloc()
308      !!-------------------------------------------------------------------
309      !!                    *** ROUTINE bio_medusa_alloc ***
310      !!-------------------------------------------------------------------
311      USE lib_mpp,           ONLY: ctl_warn
312      USE par_oce,           ONLY: jpi, jpj
313      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
314      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
315      REAL(KIND=jprb)               :: zhook_handle
316
317      CHARACTER(LEN=*), PARAMETER :: RoutineName='BIO_MEDUSA_ALLOC'
318
319      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
320
321      !!-------------------------------------------------------------------
322      !
323      ALLOCATE(zchn(jpi,jpj),zchd(jpi,jpj),zphn(jpi,jpj),             &
324               zphd(jpi,jpj),zpds(jpi,jpj),zzmi(jpi,jpj),             &
325               zzme(jpi,jpj),zdet(jpi,jpj),zdtc(jpi,jpj),             &
326               zdin(jpi,jpj),zsil(jpi,jpj),zfer(jpi,jpj),             &
327# if defined key_roam
328               zdic(jpi,jpj),zalk(jpi,jpj),zoxy(jpi,jpj),             &
329               ztmp(jpi,jpj),zsal(jpi,jpj),                           &
330# endif
331# if defined key_mocsy
332               zpho(jpi,jpj),                                         &
333# endif
334# if defined key_omip_dic
335               zomd(jpi,jpj),                                         &
336# endif
337               fthetan(jpi,jpj),fprn(jpi,jpj),frn(jpi,jpj),           &
338               fthetad(jpi,jpj),fprd(jpi,jpj),frd(jpi,jpj),           &
339               fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj),                   &
340               fun_T(jpi,jpj),fun_Q10(jpi,jpj),                       &
341               fprn_ml(jpi,jpj),fprd_ml(jpi,jpj),fchl_ml(jpi,jpj),    &
342               fnln(jpi,jpj),ffln2(jpi,jpj),                          &
343               fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj),             &
344               fsld2(jpi,jpj),                                        &
345               fsin(jpi,jpj),fprds(jpi,jpj),fsdiss(jpi,jpj),          &
346               ffetop(jpi,jpj),ffebot(jpi,jpj),ffescav(jpi,jpj),      &
347               xFree(jpi,jpj),                                        &
348               fgmipn(jpi,jpj),fgmid(jpi,jpj),fgmidc(jpi,jpj),        &
349               finmi(jpi,jpj),ficmi(jpi,jpj),                         &
350               fmigrow(jpi,jpj),fmiexcr(jpi,jpj),fmiresp(jpi,jpj),    &
351               fgmepn(jpi,jpj),fgmepd(jpi,jpj),                       &
352               fgmepds(jpi,jpj),fgmezmi(jpi,jpj),fgmed(jpi,jpj),      &
353               fgmedc(jpi,jpj),                                       &
354               finme(jpi,jpj),ficme(jpi,jpj),                         &
355               fmegrow(jpi,jpj),fmeexcr(jpi,jpj),fmeresp(jpi,jpj),    &
356               fdpn(jpi,jpj),fdpd(jpi,jpj),fdpds(jpi,jpj),            &
357               fdzmi(jpi,jpj),fdzme(jpi,jpj),fdd(jpi,jpj),            &
358# if defined key_roam
359               fddc(jpi,jpj),                                         &
360# endif
361               fdpn2(jpi,jpj),fdpd2(jpi,jpj),fdpds2(jpi,jpj),         &
362               fdzmi2(jpi,jpj),fdzme2(jpi,jpj),                       &
363               fslown(jpi,jpj),fslowc(jpi,jpj),                       &
364               fslownflux(jpi,jpj),fslowcflux(jpi,jpj),               &
365               fregen(jpi,jpj),fregensi(jpi,jpj),                     &
366               fregenfast(jpi,jpj),fregenfastsi(jpi,jpj),             &
367# if defined key_roam
368               fregenfastc(jpi,jpj),                                  &
369# endif
370          fslowsink(jpi,jpj),fslowgain(jpi,jpj),                 &
371               fslowloss(jpi,jpj),                                    &
372# if defined key_roam
373          fslowsinkc(jpi,jpj),fslowgainc(jpi,jpj),               &
374               fslowlossc(jpi,jpj),                                   &
375# endif
376               fdep1(jpi,jpj),                                        &
377               ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj),     &
378               ftempc(jpi,jpj),ftempca(jpi,jpj),                      &
379               freminn(jpi,jpj),freminsi(jpi,jpj),freminfe(jpi,jpj),  &
380               freminc(jpi,jpj),freminca(jpi,jpj),                    &
381               ffastn(jpi,jpj),ffastsi(jpi,jpj),ffastfe(jpi,jpj),     &
382               ffastc(jpi,jpj),ffastca(jpi,jpj),                      &
383               fsedn(jpi,jpj),fsedsi(jpi,jpj),fsedfe(jpi,jpj),        &
384               fsedc(jpi,jpj),fsedca(jpi,jpj),                        &
385               fccd(jpi,jpj),                                         &
386               ffast2slown(jpi,jpj),ffast2slowc(jpi,jpj),             &
387               ftot_n(jpi,jpj),ftot_si(jpi,jpj),ftot_fe(jpi,jpj),     &
388               fflx_n(jpi,jpj),fflx_si(jpi,jpj),fflx_fe(jpi,jpj),     &
389               fifd_n(jpi,jpj),fifd_si(jpi,jpj),fifd_fe(jpi,jpj),     &
390               fofd_n(jpi,jpj),fofd_si(jpi,jpj),fofd_fe(jpi,jpj),     &
391# if defined key_roam
392               ftot_c(jpi,jpj),ftot_a(jpi,jpj),ftot_o2(jpi,jpj),      &
393               fflx_c(jpi,jpj),fflx_a(jpi,jpj),fflx_o2(jpi,jpj),      &
394! I don't think fifd_a, fifd_o2, fofd_a or fofd_o2 are used - marc 11/5/17
395!               fifd_c(jpi,jpj),fifd_a(jpi,jpj),fifd_o2(jpi,jpj),      &
396!               fofd_c(jpi,jpj),fofd_a(jpi,jpj),fofd_o2(jpi,jpj),      &
397               fifd_c(jpi,jpj), fofd_c(jpi,jpj),                      &
398# endif
399               fzmi_i(jpi,jpj),fzmi_o(jpi,jpj),fzme_i(jpi,jpj),       &
400               fzme_o(jpi,jpj),                                       &
401               ftot_pn(jpi,jpj),ftot_pd(jpi,jpj),                     &
402               ftot_zmi(jpi,jpj),ftot_zme(jpi,jpj),ftot_det(jpi,jpj), &
403               ftot_dtc(jpi,jpj),                                     &
404               fnit_prod(jpi,jpj),fnit_cons(jpi,jpj),                 &
405               fsil_prod(jpi,jpj),fsil_cons(jpi,jpj),                 &
406# if defined key_roam
407               f_xco2a(jpi,jpj),                                      &
408               f_ph(jpi,jpj),f_pco2w(jpi,jpj),f_h2co3(jpi,jpj),       &
409               f_hco3(jpi,jpj),f_co3(jpi,jpj),f_co2flux(jpi,jpj),     &
410               f_TDIC(jpi,jpj),f_TALK(jpi,jpj),f_dcf(jpi,jpj),        &
411               f_henry(jpi,jpj),                                      &
412               f_pp0(jpi,jpj),                                        &
413               f_kw660(jpi,jpj),f_o2flux(jpi,jpj),f_o2sat(jpi,jpj),   &
414               f_omcal(jpi,jpj),f_omarg(jpi,jpj),                     &
415               f_pco2atm(jpi,jpj),                                    &
416#  if defined key_omip_dic
417               f_pi_xco2a(jpi,jpj),                                        &
418               f_pi_ph(jpi,jpj),f_pi_pco2w(jpi,jpj),f_pi_h2co3(jpi,jpj),   &
419               f_pi_hco3(jpi,jpj),f_pi_co3(jpi,jpj),f_pi_co2flux(jpi,jpj), &
420               f_pi_TDIC(jpi,jpj),                                         &
421               f_pi_omcal(jpi,jpj),f_pi_omarg(jpi,jpj),                    &
422               f_pi_pco2atm(jpi,jpj),                                      &
423#  endif               
424               fcomm_resp(jpi,jpj),                                   &
425               fcar_prod(jpi,jpj),fcar_cons(jpi,jpj),                 &
426               foxy_prod(jpi,jpj), foxy_cons(jpi,jpj),                &
427               foxy_anox(jpi,jpj),                                    &
428               dms_nlim(jpi,jpj),dms_wtkn(jpi,jpj),                   &
429# endif
430               f_sbenin_n(jpi,jpj),f_sbenin_fe(jpi,jpj),              &
431               f_sbenin_c(jpi,jpj),                                   &
432               f_fbenin_n(jpi,jpj),f_fbenin_fe(jpi,jpj),              &
433               f_fbenin_si(jpi,jpj),                                  &
434               f_fbenin_c(jpi,jpj),f_fbenin_ca(jpi,jpj),              &
435               f_benout_n(jpi,jpj),f_benout_fe(jpi,jpj),              &
436               f_benout_si(jpi,jpj),                                  &
437               f_benout_c(jpi,jpj),f_benout_ca(jpi,jpj),              &
438               f_benout_lyso_ca(jpi,jpj),                             &
439               f_runoff(jpi,jpj),f_riv_n(jpi,jpj),f_riv_si(jpi,jpj),  &
440               f_riv_c(jpi,jpj),f_riv_alk(jpi,jpj),                   &
441               f_riv_loc_n(jpi,jpj),f_riv_loc_si(jpi,jpj),            &
442               f_riv_loc_c(jpi,jpj),f_riv_loc_alk(jpi,jpj),           &
443               STAT = bio_medusa_alloc)
444
445      !! Check that allocation was successful
446      IF ( bio_medusa_alloc /= 0 ) THEN 
447         CALL ctl_warn('bio_medusa_alloc: failed to allocate arrays')
448      END IF
449   
450      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
451   END FUNCTION bio_medusa_alloc
452
453#else
454   !!----------------------------------------------------------------------
455   !!  Empty module :                                          No MEDUSA
456   !!----------------------------------------------------------------------
457#endif 
458
459   !!======================================================================
460END MODULE bio_medusa_mod
Note: See TracBrowser for help on using the repository browser.