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 @ 8023

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

Tidying up of headers for several files

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