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.
air_sea.F90 in branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90 @ 7986

Last change on this file since 7986 was 7986, checked in by marc, 7 years ago

Pulled detritus processes out of trcbio_medusa.F90

File size: 24.9 KB
Line 
1MODULE air_sea_mod
2   !!======================================================================
3   !!                         ***  MODULE air_sea_mod  ***
4   !! Calculate the carbon chemistry for the whole ocean
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   air_sea        ! Called in trcbio_medusa.F90
18
19   !!----------------------------------------------------------------------
20   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
21   !! $Id$
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE air_sea( kt )
28      !!---------------------------------------------------------------------
29      !!                     ***  ROUTINE air_sea  ***
30      !! This called from TRC_BIO_MEDUSA and
31      !!  - calculate air-sea gas exchange
32      !!  - river inputs
33      !!----------------------------------------------------------------------
34      USE bio_medusa_mod,    ONLY: dms_andr, dms_andr2d, dms_aran,        &
35                                   dms_aran2d, dms_hall, dms_hall2d,      &
36                                   dms_simo, dms_simo2d, dms_surf,        &
37                                   dms_surf2d, iters, f_BetaD,            &
38                                   f_co2flux, f_co2flux2d, f_co2starair,  &
39                                   f_co2starair_2d, f_co3,                &
40                                   f_dcf, f_dpco2, f_fco2a_2d, f_fco2atm, &
41                                   f_fco2w, f_fco2w_2d, f_h2co3,          &
42                                   f_hco3, f_henry, f_insitut, f_K0,      &
43                                   f_kw660, f_kw6602d, f_kwco2, f_kwo2,   &
44                                   f_o2flux, f_o2flux2d,                  &
45                                   f_o2sat, f_o2sat2d, f_ocndpco2_2d,     &
46                                   f_ocnk0_2d, f_ocnkwco2_2d,             &
47                                   f_ocnrhosw_2d, f_ocnschco2_2d,         &
48                                   f_omarg, f_omcal, f_opres,             &
49                                   f_pco2a2d, f_pco2atm,                  &
50                                   f_pco2w, f_pco2w2d, f_ph, f_pp0,       &
51                                   f_pp02d, f_rhosw,                      &
52                                   f_riv_alk, f_riv_c, f_riv_n,           &
53                                   f_riv_si, f_runoff,                    & 
54                                   f_schmidtco2, f_TALK, f_TALK2d,        &
55                                   f_TDIC, f_TDIC2d, f_xco2a, f_xco2a_2d, &
56                                   fgco2,                                 &
57                                   zalk, zchd, zchn, zdic, zdin, zoxy,    &
58                                   zpho, zsal, zsil, ztmp
59      USE dom_oce,           ONLY: e3t_0, e3t_n, gphit, tmask
60      USE gastransfer,       ONLY: gas_transfer
61      USE iom,               ONLY: lk_iomput
62      USE in_out_manager,    ONLY: lwp, numout
63      USE mocsy_wrapper,     ONLY: mocsy_interface
64      USE oce,               ONLY: PCO2a_in_cpl
65      USE par_oce,           ONLY: jpim1, jpjm1
66      USE sbc_oce,           ONLY: fr_i, lk_oasis, qsr, wndm
67      USE sms_medusa,        ONLY: jdms, jdms_input, jdms_model,          &
68                                   jriver_alk, jriver_c,                  &
69                                   jriver_n, jriver_si,                   &
70                                   riv_alk, riv_c, riv_n, riv_si,         &
71                                   zn_dms_chd, zn_dms_chn, zn_dms_din,    &
72                                   zn_dms_mld, zn_dms_qsr 
73      USE trc,               ONLY: med_diag
74      USE trcco2_medusa,     ONLY: trc_co2_medusa
75      USE trcdms_medusa,     ONLY: trc_dms_medusa
76      USE trcoxy_medusa,     ONLY: trc_oxy_medusa
77      USE zdfmxl,            ONLY: hmld
78
79   !!* Substitution
80#  include "domzgr_substitute.h90"
81
82      !! time (integer timestep)
83      INTEGER, INTENT( in ) :: kt
84
85      !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s
86      REAL, PARAMETER :: weight_CO2_mol = 44.0095  !! g / mol
87      REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d
88      REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day
89
90      INTEGER :: ji, jj
91
92# if defined key_roam
93      !!-----------------------------------------------------------
94      !! Air-sea gas exchange
95      !!-----------------------------------------------------------
96      DO jj = 2,jpjm1
97         DO ji = 2,jpim1
98            !! OPEN wet point IF..THEN loop
99            if (tmask(ji,jj,1) == 1) then
100               IF (lk_oasis) THEN
101                  !! use 2D atm xCO2 from atm coupling
102                  f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj)
103               ENDIF
104               !!
105               !! AXY (23/06/15): as part of an effort to update the
106               !!                 carbonate chemistry in MEDUSA, the gas
107               !!                 transfer velocity used in the carbon
108               !!                 and oxygen cycles has been harmonised
109               !!                 and is calculated by the same function
110               !!                 here; this harmonisation includes
111               !!                 changes to the PML carbonate chemistry
112               !!                 scheme so that it too makes use of the
113               !!                 same gas transfer velocity; the
114               !!                 preferred parameterisation of this is
115               !!                 Wanninkhof (2014), option 7
116               !!
117#   if defined key_debug_medusa
118               IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer'
119               CALL flush(numout)
120#   endif
121               CALL gas_transfer( wndm(ji,jj), 1, 7,         &  ! inputs
122                                  f_kw660(ji,jj) )              ! outputs
123#   if defined key_debug_medusa
124               IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer'
125               CALL flush(numout)
126#   endif
127            ENDIF
128         ENDDO
129      ENDDO
130
131      DO jj = 2,jpjm1
132         DO ji = 2,jpim1
133            if (tmask(ji,jj,1) == 1) then
134               !! air pressure (atm); ultimately this will use air
135               !! pressure at the base of the UKESM1 atmosphere
136               !!                                     
137               f_pp0(ji,jj)   = 1.0
138               !!
139               !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp    =', ztmp(ji,jj)
140               !! IF(lwp) WRITE(numout,*) ' MEDUSA wndm    =', wndm(ji,jj)
141               !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i    =', fr_i(ji,jj)
142               !!
143#  if defined key_axy_carbchem
144#   if defined key_mocsy
145               !!
146               !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate
147               !!                 chemistry package; note that depth is set to
148               !!                 zero in this call
149               CALL mocsy_interface(ztmp(ji,jj),zsal(ji,jj),zalk(ji,jj),     &
150                                    zdic(ji,jj),zsil(ji,jj),zpho(ji,jj),     &
151                                    f_pp0(ji,jj),0.0,                        &
152                                    gphit(ji,jj),f_kw660(ji,jj),             &
153                                    f_xco2a(ji,jj),1,f_ph(ji,jj),            &
154                                    f_pco2w(ji,jj),f_fco2w(ji,jj),           &
155                                    f_h2co3(ji,jj),f_hco3(ji,jj),            &
156                                    f_co3(ji,jj),f_omarg(ji,jj),             &
157                                    f_omcal(ji,jj),f_BetaD(ji,jj),           &
158                                    f_rhosw(ji,jj),f_opres(ji,jj),           &
159                                    f_insitut(ji,jj),f_pco2atm(ji,jj),       &
160                                    f_fco2atm(ji,jj),f_schmidtco2(ji,jj),    &
161                                    f_kwco2(ji,jj),f_K0(ji,jj),              &
162                                    f_co2starair(ji,jj),f_co2flux(ji,jj),    &
163                                    f_dpco2(ji,jj))
164               !! mmol / m3 -> umol / kg
165               f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw(ji,jj)) * 1000.
166               !! meq / m3 ->  ueq / kg
167               f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000.
168               f_dcf(ji,jj)  = f_rhosw(ji,jj)
169            ENDIF
170         ENDDO
171      ENDDO
172
173#   else   
174
175      DO jj = 2,jpjm1
176         DO ji = 2,jpim1
177            if (tmask(ji,jj,1) == 1) then     
178               iters(ji,jj) = 0
179               !!
180               !! carbon dioxide (CO2); Jerry Blackford code (ostensibly
181               !! OCMIP-2, but not)
182               CALL trc_co2_medusa(ztmp(ji,jj),zsal(ji,jj),zdic(ji,jj),      &
183                                   zalk(ji,jj),0.0,                          &
184                                   f_kw660(ji,jj),f_xco2a(ji,jj),            &
185                                   f_ph(ji,jj),                              &
186                                   f_pco2w(ji,jj),f_h2co3(ji,jj),            &
187                                   f_hco3(ji,jj),f_co3(ji,jj),               &
188                                   f_omcal(ji,jj),f_omarg(ji,jj),            &
189                                   f_co2flux(ji,jj),f_TDIC(ji,jj),           &
190                                   f_TALK(ji,jj),f_dcf(ji,jj),               &
191                                   f_henry(ji,jj),iters(ji,jj))
192               !!
193               !! AXY (09/01/14): removed iteration and NaN checks; these have
194               !!                 been moved to trc_co2_medusa together with a
195               !!                 fudge that amends erroneous values (this is
196               !!                 intended to be a temporary fudge!); the
197               !!                 output warnings are retained here so that
198               !!                 failure position can be determined
199               if (iters(ji,jj) .eq. 25) then
200                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', &
201                     iters(ji,jj), ' AT (', ji, ', ', jj, ', 1) AT ', kt
202               endif
203            ENDIF
204         ENDDO
205      ENDDO
206
207#   endif
208#  else
209
210      DO jj = 2,jpjm1
211         DO ji = 2,jpim1
212            if (tmask(ji,jj,1) == 1) then
213               !! AXY (18/04/13): switch off carbonate chemistry
214               !!                 calculations; provide quasi-sensible
215               !!                 alternatives
216               f_ph(ji,jj)           = 8.1
217               f_pco2w(ji,jj)        = f_xco2a(ji,jj)
218               f_h2co3(ji,jj)        = 0.005 * zdic(ji,jj)
219               f_hco3(ji,jj)         = 0.865 * zdic(ji,jj)
220               f_co3(ji,jj)          = 0.130 * zdic(ji,jj)
221               f_omcal(ji,jj) = 4.
222               f_omarg(ji,jj) = 2.
223               f_co2flux(ji,jj)      = 0.
224               f_TDIC(ji,jj)         = zdic(ji,jj)
225               f_TALK(ji,jj)         = zalk(ji,jj)
226               f_dcf(ji,jj)          = 1.026
227               f_henry(ji,jj)        = 1.
228               !! AXY (23/06/15): add in some extra MOCSY diagnostics
229               f_fco2w(ji,jj)        = f_xco2a(ji,jj)
230               f_BetaD(ji,jj)        = 1.
231               f_rhosw(ji,jj)        = 1.026
232               f_opres(ji,jj)        = 0.
233               f_insitut(ji,jj)      = ztmp(ji,jj)
234               f_pco2atm(ji,jj)      = f_xco2a(ji,jj)
235               f_fco2atm(ji,jj)      = f_xco2a(ji,jj)
236               f_schmidtco2(ji,jj)   = 660.
237               f_kwco2(ji,jj)        = 0.
238               f_K0(ji,jj)           = 0.
239               f_co2starair(ji,jj)   = f_xco2a(ji,jj)
240               f_dpco2(ji,jj)        = 0.
241            ENDIF
242         ENDDO
243      ENDDO
244#  endif
245
246      DO jj = 2,jpjm1
247         DO ji = 2,jpim1
248            if (tmask(ji,jj,1) == 1) then
249               !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide
250               !! through by layer thickness
251               f_co2flux(ji,jj) = (1. - fr_i(ji,jj)) * f_co2flux(ji,jj) *    &
252                                  86400. / fse3t(ji,jj,1)
253               !!
254               !! oxygen (O2); OCMIP-2 code
255               !! AXY (23/06/15): amend input list for oxygen to account
256               !!                 for common gas transfer velocity
257               !! Note that f_kwo2 is an about from the subroutine below,
258               !! which doesn't seem to be used - marc 10/4/17
259               CALL trc_oxy_medusa(ztmp(ji,jj),zsal(ji,jj),f_kw660(ji,jj),   &
260                                   f_pp0(ji,jj),zoxy(ji,jj),                 &
261                                   f_kwo2(ji,jj),f_o2flux(ji,jj),            &
262                                   f_o2sat(ji,jj))
263               !!
264               !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide
265               !! through by layer thickness
266               f_o2flux(ji,jj)  = (1. - fr_i(ji,jj)) * f_o2flux(ji,jj) *     &
267                                  86400. / fse3t(ji,jj,1)
268            ENDIF
269         ENDDO
270      ENDDO
271
272      !! Jpalm (08-2014)
273      !! DMS surface concentration calculation
274      !! initialy added for UKESM1 model.
275      !! using MET-OFFICE subroutine.
276      !! DMS module only needs Chl concentration and MLD
277      !! to get an aproximate value of DMS concentration.
278      !! air-sea fluxes are calculated by atmospheric chemitry model
279      !! from atm and oc-surface concentrations.
280      !!
281      !! AXY (13/03/15): this is amended to calculate all of the DMS
282      !!                 estimates examined during UKESM1 (see
283      !!                 comments in trcdms_medusa.F90)
284      !!
285      IF (jdms == 1) THEN
286         DO jj = 2,jpjm1
287            DO ji = 2,jpim1
288               if (tmask(ji,jj,1) == 1) then
289                  !!
290                  !! feed in correct inputs
291                  if (jdms_input .eq. 0) then
292                     !! use instantaneous inputs
293                     CALL trc_dms_medusa(zchn(ji,jj),zchd(ji,jj),             &
294                                         hmld(ji,jj),qsr(ji,jj),              &
295                                         zdin(ji,jj),                         &
296                                         dms_andr(ji,jj),dms_simo(ji,jj),     &
297                                         dms_aran(ji,jj),dms_hall(ji,jj))
298                  else
299                     !! use diel-average inputs
300                     CALL trc_dms_medusa(zn_dms_chn(ji,jj),zn_dms_chd(ji,jj), &
301                                         zn_dms_mld(ji,jj),zn_dms_qsr(ji,jj), &
302                                         zn_dms_din(ji,jj),                   &
303                                         dms_andr(ji,jj),dms_simo(ji,jj),     &
304                                         dms_aran(ji,jj),dms_hall(ji,jj))
305                  endif
306                  !!
307                  !! assign correct output to variable passed to atmosphere
308                  if (jdms_model .eq. 1) then
309                     dms_surf(ji,jj) = dms_andr(ji,jj)
310                  elseif (jdms_model .eq. 2) then
311                     dms_surf(ji,jj) = dms_simo(ji,jj)
312                  elseif (jdms_model .eq. 3) then
313                     dms_surf(ji,jj) = dms_aran(ji,jj)
314                  elseif (jdms_model .eq. 4) then
315                     dms_surf(ji,jj) = dms_hall(ji,jj)
316                  endif
317                  !!
318                  !! 2D diag through iom_use
319                  IF( lk_iomput ) THEN
320                     IF( med_diag%DMS_SURF%dgsave ) THEN
321                        dms_surf2d(ji,jj) = dms_surf(ji,jj)
322                     ENDIF
323                     IF( med_diag%DMS_ANDR%dgsave ) THEN
324                        dms_andr2d(ji,jj) = dms_andr(ji,jj)
325                     ENDIF
326                     IF( med_diag%DMS_SIMO%dgsave ) THEN
327                        dms_simo2d(ji,jj) = dms_simo(ji,jj)
328                     ENDIF
329                     IF( med_diag%DMS_ARAN%dgsave ) THEN
330                        dms_aran2d(ji,jj) = dms_aran(ji,jj)
331                     ENDIF
332                     IF( med_diag%DMS_HALL%dgsave ) THEN
333                        dms_hall2d(ji,jj) = dms_hall(ji,jj)
334                     ENDIF
335#   if defined key_debug_medusa
336                     IF (lwp) write (numout,*)                                &
337                        'trc_bio_medusa: finish calculating dms'
338                     CALL flush(numout)
339#   endif
340                  ENDIF      !! End iom
341               ENDIF
342            ENDDO
343         ENDDO
344      ENDIF                  !! End IF (jdms == 1)
345
346
347      !!
348      !! store 2D outputs
349      !!
350      !! JPALM -- 17-11-16 -- put fgco2 out of diag request
351      !!       is needed for coupling; pass through restart
352      DO jj = 2,jpjm1
353         DO ji = 2,jpim1
354            if (tmask(ji,jj,1) == 1) then
355               !! IF( med_diag%FGCO2%dgsave ) THEN
356               !! convert from  mol/m2/day to kg/m2/s
357               !! mmol-C/m3/d -> kg-CO2/m2/s
358               fgco2(ji,jj) = f_co2flux(ji,jj) * fse3t(ji,jj,1) *             &
359                              CO2flux_conv
360               !! ENDIF
361               IF ( lk_iomput ) THEN
362                  IF( med_diag%ATM_PCO2%dgsave ) THEN
363                     f_pco2a2d(ji,jj) = f_pco2atm(ji,jj)
364                  ENDIF
365                  IF( med_diag%OCN_PCO2%dgsave ) THEN
366                     f_pco2w2d(ji,jj) = f_pco2w(ji,jj)
367                  ENDIF
368                  IF( med_diag%CO2FLUX%dgsave ) THEN
369                     !! mmol/m3/d -> mmol/m2/d
370                     f_co2flux2d(ji,jj) = f_co2flux(ji,jj) * fse3t(ji,jj,1)
371                  ENDIF
372                  IF( med_diag%TCO2%dgsave ) THEN
373                     f_TDIC2d(ji,jj) = f_TDIC(ji,jj)
374                  ENDIF
375                  IF( med_diag%TALK%dgsave ) THEN
376                     f_TALK2d(ji,jj) = f_TALK(ji,jj)
377                  ENDIF
378                  IF( med_diag%KW660%dgsave ) THEN
379                      f_kw6602d(ji,jj) = f_kw660(ji,jj)
380                  ENDIF
381                  IF( med_diag%ATM_PP0%dgsave ) THEN
382                      f_pp02d(ji,jj) = f_pp0(ji,jj)
383                  ENDIF
384                  IF( med_diag%O2FLUX%dgsave ) THEN
385                     f_o2flux2d(ji,jj) = f_o2flux(ji,jj)
386                  ENDIF
387                  IF( med_diag%O2SAT%dgsave ) THEN
388                     f_o2sat2d(ji,jj) = f_o2sat(ji,jj)
389                  ENDIF
390                  !! AXY (24/11/16): add in extra MOCSY diagnostics
391                  IF( med_diag%ATM_XCO2%dgsave ) THEN
392                     f_xco2a_2d(ji,jj) = f_xco2a(ji,jj)
393                  ENDIF
394                  IF( med_diag%OCN_FCO2%dgsave ) THEN
395                     f_fco2w_2d(ji,jj) = f_fco2w(ji,jj)
396                  ENDIF
397                  IF( med_diag%ATM_FCO2%dgsave ) THEN
398                     f_fco2a_2d(ji,jj) = f_fco2atm(ji,jj)
399                  ENDIF
400                  IF( med_diag%OCN_RHOSW%dgsave ) THEN
401                     f_ocnrhosw_2d(ji,jj) = f_rhosw(ji,jj)
402                  ENDIF
403                  IF( med_diag%OCN_SCHCO2%dgsave ) THEN
404                     f_ocnschco2_2d(ji,jj) = f_schmidtco2(ji,jj)
405                  ENDIF
406                  IF( med_diag%OCN_KWCO2%dgsave ) THEN
407                     f_ocnkwco2_2d(ji,jj) = f_kwco2(ji,jj)
408                  ENDIF
409                  IF( med_diag%OCN_K0%dgsave ) THEN
410                     f_ocnk0_2d(ji,jj) = f_K0(ji,jj)
411                  ENDIF
412                  IF( med_diag%CO2STARAIR%dgsave ) THEN
413                     f_co2starair_2d(ji,jj) = f_co2starair(ji,jj)
414                  ENDIF
415                  IF( med_diag%OCN_DPCO2%dgsave ) THEN
416                     f_ocndpco2_2d(ji,jj) = f_dpco2(ji,jj)
417                  ENDIF
418               ENDIF
419            ENDIF
420         ENDDO
421      ENDDO
422
423# endif
424
425      !!-----------------------------------------------------------------
426      !! River inputs
427      !!-----------------------------------------------------------------
428      DO jj = 2,jpjm1
429         DO ji = 2,jpim1
430            !! OPEN wet point IF..THEN loop
431            if (tmask(ji,jj,1) == 1) then
432               !!
433               !! runoff comes in as        kg / m2 / s
434               !! used and written out as   m3 / m2 / d (= m / d)
435               !! where                     1000 kg / m2 / d =
436               !!                             1 m3 / m2 / d = 1 m / d
437               !!
438               !! AXY (17/07/14): the compiler doesn't like this line for
439               !!                 some reason; as MEDUSA doesn't even use
440               !!                 runoff for riverine inputs, a temporary
441               !!                 solution is to switch off runoff entirely
442               !!                 here; again, this change is one of several
443               !!                 that will need revisiting once MEDUSA has
444               !!                 bedded down in UKESM1; particularly so if
445               !!                 the land scheme provides information
446               !!                 concerning nutrient fluxes
447               !!
448               !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. *   &
449               !!                   60. * 24.
450               f_runoff(ji,jj) = 0.0
451               !!
452               !! nutrients are added via rivers to the model in one of
453               !! two ways:
454               !!   1. via river concentration; i.e. the average nutrient
455               !!      concentration of a river water is described by a
456               !!      spatial file, and this is multiplied by runoff to
457               !!      give a nutrient flux
458               !!   2. via direct river flux; i.e. the average nutrient
459               !!      flux due to rivers is described by a spatial file,
460               !!      and this is simply applied as a direct nutrient
461               !!      flux (i.e. it does not relate or respond to model
462               !!      runoff) nutrient fields are derived from the
463               !!      GlobalNEWS 2 database; carbon and alkalinity are
464               !!      derived from continent-scale DIC estimates (Huang et
465               !!      al., 2012) and some Arctic river alkalinity
466               !!      estimates (Katya?)
467               !!
468               !! as of 19/07/12, riverine nutrients can now be spread
469               !! vertically across several grid cells rather than just
470               !! poured into the surface box; this block of code is still
471               !! executed, however, to set up the total amounts of
472               !! nutrient entering via rivers
473               !!
474               !! nitrogen
475               if (jriver_n .eq. 1) then
476                  !! river concentration specified; use runoff to
477                  !! calculate input
478                  f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj)
479               elseif (jriver_n .eq. 2) then
480                  !! river flux specified; independent of runoff
481                  f_riv_n(ji,jj) = riv_n(ji,jj)
482               endif
483               !!
484               !! silicon
485               if (jriver_si .eq. 1) then
486                  !! river concentration specified; use runoff to
487                  !! calculate input
488                  f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj)
489               elseif (jriver_si .eq. 2) then
490                  !! river flux specified; independent of runoff
491                  f_riv_si(ji,jj) = riv_si(ji,jj)
492               endif
493               !!
494               !! carbon
495               if (jriver_c .eq. 1) then
496                  !! river concentration specified; use runoff to
497                  !! calculate input
498                  f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj)
499               elseif (jriver_c .eq. 2) then
500                  !! river flux specified; independent of runoff
501                  f_riv_c(ji,jj) = riv_c(ji,jj)
502               endif
503               !!
504               !! alkalinity
505               if (jriver_alk .eq. 1) then
506                  !! river concentration specified; use runoff to
507                  !! calculate input
508                  f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj)
509               elseif (jriver_alk .eq. 2) then
510                  !! river flux specified; independent of runoff
511                  f_riv_alk(ji,jj) = riv_alk(ji,jj)
512               endif
513            ENDIF
514         ENDDO
515      ENDDO
516
517   END SUBROUTINE air_sea
518
519#else
520   !!======================================================================
521   !!  Dummy module :                                   No MEDUSA bio-model
522   !!======================================================================
523CONTAINS
524   SUBROUTINE air_sea( )                    ! Empty routine
525      WRITE(*,*) 'air_sea: You should not have seen this print! error?'
526   END SUBROUTINE air_sea
527#endif 
528
529   !!======================================================================
530END MODULE air_sea_mod
Note: See TracBrowser for help on using the repository browser.