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

Last change on this file since 564 was 564, checked in by opalod, 17 years ago

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