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.
trcini.pisces.h90 in trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/trcini.pisces.h90 @ 494

Last change on this file since 494 was 494, checked in by opalod, 18 years ago

nemo_v1_update_062:CE+RB: use IOM for passive tracers

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.3 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                    ***  trcini.pisces.h90 ***
3   !!----------------------------------------------------------------------
4#  include "domzgr_substitute.h90"
5#  include "passivetrc_substitute.h90"
6CONTAINS
7
8   SUBROUTINE trc_ini
9      !!-----------------------------------------------------------------
10      !!
11      !!                   ***  ROUTINE trc_ini ***
12      !!                     
13      !!
14      !!  Purpose :
15      !!  ---------
16      !!     Initialisation of PISCES biological and chemical variables
17      !!
18      !!   INPUT :
19      !!   -----
20      !!      common
21      !!              all the common defined in opa
22      !!
23      !!
24      !!   OUTPUT :                   : no
25      !!   ------
26      !!
27      !!   EXTERNAL :
28      !!   ----------
29      !!         p4zche
30      !!
31      !!   MODIFICATIONS:
32      !!   --------------
33      !!      original  : 1988-07  E. MAIER-REIMER      MPI HAMBURG
34      !!      additions : 1999-10  O. Aumont and C. Le Quere
35      !!      additions : 2002     O. Aumont (PISCES)
36      !!     03-2005 O. Aumont and A. El Moussaoui F90
37      !!----------------------------------------------------------------------
38      !!  TOP 1.0 , LOCEAN-IPSL (2005)
39      !! $Header$
40      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
41      !!----------------------------------------------------------------------
42      !!Module used
43      USE iom
44
45      !! local declarations
46      !! ==================
47      INTEGER :: ji,jj,jk
48      INTEGER :: ichl,iband,jm
49      INTEGER , PARAMETER :: jpmois = 12, jpan   = 1
50
51      REAL(wp) :: ztoto,expide,denitide,ztra,zmaskt
52      REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc,river,ndepo
53
54      INTEGER :: numriv,numdust,numbath,numdep
55      INTEGER :: numlight = 49
56
57
58      !! 1. initialization
59      !! -----------------
60
61      !! computation of the record length for direct access FILE
62      !! this length depend of 512 for the t3d machine
63      !!
64      rfact = rdttra(1) * float(ndttrc)
65      rfactr = 1./rfact
66      IF(lwp) WRITE(numout,*) ' Tracer time step=',rfact,' rdt=',rdt
67      rfact2= rfact / float(nrdttrc)
68      rfact2r = 1./rfact2
69      IF(lwp) write(numout,*) ' Biology time step=',rfact2
70
71
72      !!    INITIALISE DUST INPUT FROM ATMOSPHERE
73      !!    -------------------------------------
74
75      IF ( bdustfer ) THEN
76         IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere '
77         CALL iom_open ( 'dust.orca.nc', numdust )
78         DO jm = 1, jpmois
79            CALL iom_get  ( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm )
80         ENDDO
81         CALL iom_close( numdust )
82      ELSE
83         dustmo(:,:,:) = 0.
84      ENDIF
85
86      do jm = 1, jpmois
87        write(numout,*) ' Mois : ',jm
88        write(numout,*) ( ( dustmo(ji,jj,jm), ji=1,jpi,20),jj=1,jpj,20)
89      enddo
90
91
92      !!    INITIALISE THE NUTRIENT INPUT BY RIVERS
93      !!    ---------------------------------------
94
95      IF ( briver ) THEN
96         IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers '
97         CALL iom_open ( 'river.orca.nc', numriv )
98         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan )
99         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan )
100         CALL iom_close( numriv )
101      ELSE
102         river   (:,:) = 0.
103         riverdoc(:,:) = 0.
104      endif
105
106      !!    INITIALISE THE N INPUT BY DUST
107      !!  ---------------------------------------
108
109      IF ( bndepo ) THEN
110         IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust '
111         CALL iom_open ( 'ndeposition.orca.nc', numdep )
112         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan )
113         CALL iom_close( numdep )
114      ELSE
115         ndepo(:,:) = 0.
116      ENDIF
117
118      !!    Computation of the coastal mask.
119      !!    Computation of an island mask to enhance coastal supply of iron
120      !!    ---------------------------------------------------------------
121
122      IF ( bsedinput ) THEN
123         IF(lwp) WRITE(numout,*) '  Computation of an island mask to enhance coastal supply of iron '
124         CALL iom_open ( 'bathy.orca.nc', numbath )
125         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan )
126
127         DO jk = 1, 5
128            DO jj = 2, jpjm1
129               DO ji = 2, jpim1
130                  IF ( tmask(ji,jj,jk) /= 0. ) THEN
131                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
132                        &          * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
133                     IF ( zmaskt == 0. ) THEN
134                        cmask(ji,jj,jk ) = 0.1
135                     ENDIF
136                  ENDIF
137               END DO
138            END DO
139         END DO
140         DO jk = 1, jpk
141            DO jj = 1, jpj
142               DO ji = 1, jpi
143                  expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
144                  denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2
145                  cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )
146               END DO
147            END DO
148         END DO
149         
150         CALL iom_close( numbath )
151      ELSE
152         cmask(:,:,:) = 0.
153      ENDIF
154
155      ! Lateral boundary conditions on ( avt, en )   (sign unchanged)
156      CALL lbc_lnk( cmask , 'T', 1. )
157
158      !!     Computation of the total atmospheric supply of Si
159      !!     -------------------------------------------------
160
161      sumdepsi = 0.
162      DO jm = 1, jpmois
163         DO jj = 2, jpjm1
164            DO ji = 2, jpim1
165               sumdepsi = sumdepsi + dustmo(ji,jj,jm)/(12.*rmoss)*8.8        &
166                  *0.075/28.1*e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1)
167            END DO
168         END DO
169      END DO
170
171      IF( lk_mpp )   CALL mpp_sum( sumdepsi )  ! sum over the global domain
172
173      !!    COMPUTATION OF THE N/P RELEASE DUE TO COASTAL RIVERS
174      !!    COMPUTATION OF THE Si RELEASE DUE TO COASTAL RIVERS
175      !!    ---------------------------------------------------
176
177      DO jj=1,jpj
178         DO ji=1,jpi
179            cotdep(ji,jj)=river(ji,jj)*1E9/(12.*raass                          &
180               *e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)*tmask(ji,jj,1)
181            rivinp(ji,jj)=(river(ji,jj)+riverdoc(ji,jj))*1E9                   &
182               /(31.6*raass*e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)   &
183               *tmask(ji,jj,1)
184            nitdep(ji,jj)=7.6*ndepo(ji,jj)*tmask(ji,jj,1)/(14E6*raass          &
185               *fse3t(ji,jj,1)+rtrn)
186         END DO
187      END DO
188      ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged)
189      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. )
190
191      rivpo4input=0.
192      rivalkinput=0.
193      nitdepinput=0.
194      DO jj=2,jpjm1
195         DO ji=2,jpim1
196            rivpo4input=rivpo4input+rivinp(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    &
197               *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
198            rivalkinput=rivalkinput+cotdep(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    &
199               *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
200            nitdepinput=nitdepinput+nitdep(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    &
201               *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
202         END DO
203      END DO
204
205      IF( lk_mpp ) THEN
206         CALL mpp_sum( rivpo4input )  ! sum over the global domain
207         CALL mpp_sum( rivalkinput )  ! sum over the global domain
208         CALL mpp_sum( nitdepinput )  ! sum over the global domain
209      ENDIF
210
211
212      !!    Coastal supply of iron
213      !!    ----------------------
214
215      DO jk=1,jpkm1
216         ironsed(:,:,jk)=sedfeinput*cmask(:,:,jk)         &
217            /(fse3t(:,:,jk)*rjjss)
218      END DO
219
220      ! Lateral boundary conditions on ( ironsed )   (sign unchanged)
221      CALL lbc_lnk( ironsed , 'T', 1. )
222      !!----------------------------------------------------------------------
223      !!
224      !! Initialize biological variables
225      !!
226      !!----------------------------------------------------------------------
227      !! Set biological ratios
228      !! ---------------------
229
230      rno3   = (16.+2.)/122.
231      po4r   = 1./122.
232      o2nit  = 32./122.
233      rdenit = 97.6/16.
234      o2ut   = 140./122.
235
236      !!----------------------------------------------------------------------
237      !!
238      !! Initialize chemical variables
239      !!
240      !!----------------------------------------------------------------------
241
242      !! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio
243      !! ----------------------------------------------------------
244
245      atcox = 0.20946
246
247      !! Set lower/upper limits for temperature and salinity
248      !! ---------------------------------------------------
249
250      salchl = 1./1.80655
251      calcon = 1.03E-2
252
253      !! Set coefficients for apparent solubility equilibrium
254      !!   of calcite (Ingle, 1800, eq. 6)
255      !! ----------------------------------------------------
256
257      akcc1 = -34.452
258      akcc2 = -39.866
259      akcc3 = 110.21
260      akcc4 = -7.5752E-6
261
262
263      !! Set coefficients for seawater pressure correction
264      !! -------------------------------------------------
265
266      devk1(1) = -25.5
267      devk2(1) = 0.1271
268      devk3(1) = 0.
269      devk4(1) = -3.08E-3
270      devk5(1) = 0.0877E-3
271
272      devk1(2) = -15.82
273      devk2(2) = -0.0219
274      devk3(2) = 0.
275      devk4(2) = 1.13E-3
276      devk5(2) = -0.1475E-3
277
278      devk1(3) = -29.48
279      devk2(3) = 0.1622
280      devk3(3) = 2.608E-3
281      devk4(3) = -2.84E-3
282      devk5(3) = 0.
283
284      devk1(4) = -25.60
285      devk2(4) = 0.2324
286      devk3(4) = -3.6246E-3
287      devk4(4) = -5.13E-3
288      devk5(4) = 0.0794E-3
289
290      devkst = 0.23
291      devks  = 35.4
292
293      !! Set universal gas constants
294      !! ---------------------------
295
296      rgas = 83.143
297      oxyco = 1./22.4144
298
299      !! Set boron constants
300      !! -------------------
301
302      bor1 = 0.00023
303      bor2 = 1./10.82
304
305      !! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974)
306      !! -----------------------------------------------------------------
307
308      c00 = -60.2409
309      c01 = 93.4517
310      c02 = 23.3585
311      c03 = 0.023517
312      c04 = -0.023656
313      c05 = 0.0047036
314
315      ca0 = -162.8301
316      ca1 = 218.2968
317      ca2 = 90.9241
318      ca3 = -1.47696
319      ca4 = 0.025695
320      ca5 = -0.025225
321      ca6 = 0.0049867
322
323      !! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)
324      !! ---------------------------------------------------------------------
325
326      c10 = -3670.7
327      c11 =  62.008
328      c12 = -9.7944
329      c13 = 0.0118
330      c14 = -0.000116
331
332      !! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970)
333      !! ---------------------------------------------------------------------
334
335      c20 = -1394.7
336      c21 = -4.777
337      c22 = 0.0184
338      c23 = -0.000118
339
340      !! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970)
341      !! ------------------------------------------------------------------
342
343      cb0  = -8966.90
344      cb1  = -2890.53
345      cb2  = -77.942
346      cb3  = 1.728
347      cb4  = -0.0996
348      cb5  = 148.0248
349      cb6  = 137.1942
350      cb7  = 1.62142
351      cb8  = -24.4344
352      cb9  = -25.085
353      cb10 = -0.2474
354      cb11 = 0.053105
355
356      !! Set coeff. for dissoc. of water (Dickson and Riley, 1979,
357      !!   eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415
358      !!   after pers. commun. to B. Bacastow, 1988)
359      !! ---------------------------------------------------------
360
361      cw0 = -13847.26
362      cw1 = 148.9652
363      cw2 = -23.6521
364      cw3 = 118.67
365      cw4 = -5.977
366      cw5 = 1.0495
367      cw6 = -0.01615
368
369      !
370      ! Set coeff. for dissoc. of phosphate (Millero (1974)
371      ! ---------------------------------------------------
372      !
373      cp10 = 115.525
374      cp11 = -4576.752
375      cp12 = -18.453
376      cp13 = -106.736
377      cp14 = 0.69171
378      cp15 = -0.65643
379      cp16 = -0.01844
380
381      cp20 = 172.0883
382      cp21 = -8814.715
383      cp22 = -27.927
384      cp23 = -160.340
385      cp24 = 1.3566
386      cp25 = 0.37335
387      cp26 = -0.05778
388
389
390      cp30 = -18.141
391      cp31 = -3070.75
392      cp32 = 17.27039
393      cp33 = 2.81197
394      cp34 = -44.99486
395      cp35 = -0.09984
396      !
397      ! Set coeff. for dissoc. of phosphate (Millero (1974)
398      ! ---------------------------------------------------
399      !
400      cs10 = 117.385
401      cs11 = -8904.2
402      cs12 = -19.334
403      cs13 = -458.79
404      cs14 =  3.5913
405      cs15 = 188.74
406      cs16 = -1.5998
407      cs17 = -12.1652
408      cs18 = 0.07871
409      cs19 = -0.001005
410
411      !! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970)
412      !! ----------------------------------------------------------------
413
414      ox0 = -58.3877
415      ox1 = 85.8079
416      ox2 = 23.8439
417      ox3 = -0.034892
418      ox4 = 0.015568
419      ox5 = -0.0019387
420
421      !!  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE
422      !!  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT
423
424      OPEN( numlight, file = 'kRGB61.txt', form = 'formatted')
425      DO ichl = 1,61
426         READ(numlight,*) ztoto,(xkrgb(iband,ichl),iband = 1,3)
427      END DO
428      CLOSE(numlight)
429
430
431      !!  Call p4zche to initialize the chemical constants
432      !!  ------------------------------------------------
433
434      CALL p4zche
435      !!
436      !!  Initialize a counter for the computation of chemistry
437      !!
438      ndayflxtr=0
439
440      IF(lwp) WRITE(numout,*) ' Initialisation of PISCES done'
441
442   END SUBROUTINE trc_ini
Note: See TracBrowser for help on using the repository browser.