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

Last change on this file since 260 was 260, checked in by opalod, 19 years ago

nemo_v1_update_005:RB+OA: Update and rewritting of (part of) the TOP component.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.9 KB
Line 
1!!-----------------------------------------------------------------
2!!
3!!                     ROUTINE trcini.pisces.h90
4!!                     ************************
5!!
6!!  PURPOSE :
7!!  ---------
8!!     Initialisation of PISCES biological and chemical variables
9!!
10!!   INPUT :
11!!   -----
12!!      common
13!!              all the common defined in opa
14!!
15!!
16!!   OUTPUT :                   : no
17!!   ------
18!!
19!!   EXTERNAL :
20!!   ----------
21!!         p4zche
22!!
23!!   MODIFICATIONS:
24!!   --------------
25!!      original  : 1988-07  E. MAIER-REIMER      MPI HAMBURG
26!!      additions : 1999-10  O. Aumont and C. Le Quere
27!!      additions : 2002     O. Aumont (PISCES)
28!!     03-2005 O. Aumont and A. El Moussaoui F90
29!!---------------------------------------------------------------------
30!! local declarations
31!! ==================
32      INTEGER :: ichl,iband,mo
33      INTEGER , PARAMETER :: jpmois = 12,      &
34                             jpan   = 1
35
36      REAL(wp) :: xtoto,expide,denitide,ztra
37      REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc,river,ndepo
38      CHARACTER (len=34) :: clname
39
40      INTEGER :: ipi,ipj,ipk,itime
41      INTEGER , DIMENSION (jpmois) :: istep
42      INTEGER , DIMENSION (jpan) :: istep0
43      REAL(wp) :: zsecond, zdate0
44      REAL(wp) , DIMENSION (jpi,jpj) :: zlon,zlat
45      REAL(wp), DIMENSION (jpk) :: zlev
46      INTEGER :: numriv,numdust,numbath,numdep
47
48!! 1. initialization
49!! -----------------
50
51!! computation of the record length for direct access FILE
52!! this length depend of 512 for the t3d machine
53!!
54      rfact = rdttra(1) * float(ndttrc)
55      rfactr = 1./rfact
56      IF(lwp) WRITE(numout,*) ' Tracer time step=',rfact,' rdt=',rdt
57      rfact2= rfact / float(nrdttrc)
58      rfact2r = 1./rfact2
59      IF(lwp) write(numout,*) ' Biology time step=',rfact2
60
61!!    INITIALISE DUST INPUT FROM ATMOSPHERE
62!!    -------------------------------------
63
64       IF (bdustfer) THEN
65         clname='dust.orca.nc'
66       CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0        &
67     &      ,zlon,zlat,zlev,itime,istep,zdate0,zsecond,numdust)
68       CALL flinget(numdust,'dust',jpidta,jpjdta,0,jpmois,1,                 &
69     &        12,mig(1),nlci,mjg(1),nlcj,dustmo(1:nlci,1:nlcj,:) )
70       CALL flinclo(numdust)
71
72        ! Extra-halo initialization in MPP
73         IF( lk_mpp ) THEN
74            DO ji = nlci+1, jpi
75               dustmo(ji,:,:) = dustmo(1,:,:)
76            ENDDO
77            DO jj = nlcj+1, jpj
78               dustmo(:,jj,:)=dustmo(:,1,:)
79            ENDDO
80         ENDIF
81       ELSE
82       dustmo(:,:,:)=0.
83       ENDIF
84
85!!    INITIALISE THE NUTRIENT INPUT BY RIVERS
86!!    ---------------------------------------
87
88       IF (briver) THEN
89        clname='river.orca.nc'
90       CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0        &
91      &      ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numriv)
92       CALL flinget(numriv,'riverdic',jpidta,jpjdta,0,jpan,1,                &
93      &        1,mig(1),nlci,mjg(1),nlcj,river(1:nlci,1:nlcj) )
94       CALL flinget(numriv,'riverdoc',jpidta,jpjdta,0,jpan,1,                &
95      &        1,mig(1),nlci,mjg(1),nlcj,riverdoc(1:nlci,1:nlcj) )
96       CALL flinclo(numriv)
97
98        ! Extra-halo initialization in MPP
99         IF( lk_mpp ) THEN
100            DO ji = nlci+1, jpi
101               river(ji,:) = river(1,:)
102               riverdoc(ji,:) = riverdoc(1,:)
103            ENDDO
104            DO jj = nlcj+1, jpj
105               river(:,jj)=river(:,1)
106               riverdoc(:,jj) = riverdoc(:,1)
107            ENDDO
108         ENDIF
109
110       ELSE
111       river(:,:)=0.
112       riverdoc(:,:)=0.
113       endif
114
115!!    INITIALISE THE N INPUT BY DUST
116!!  ---------------------------------------
117
118       IF (bndepo) THEN
119        clname='ndeposition.orca.nc'
120       CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0        &
121     &      ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numdep)
122       CALL flinget(numdep,'ndep',jpidta,jpjdta,0,jpan,1,                   &
123     &        1,mig(1),nlci,mjg(1),nlcj,ndepo(1:nlci,1:nlcj) )
124       CALL flinclo(numdep)
125
126        ! Extra-halo initialization in MPP
127         IF( lk_mpp ) THEN
128            DO ji = nlci+1, jpi
129               ndepo(ji,:) = ndepo(1,:)
130            ENDDO
131            DO jj = nlcj+1, jpj
132               ndepo(:,jj)=ndepo(:,1)
133            ENDDO
134         ENDIF
135
136       ELSE
137       ndepo(:,:)=0.
138       ENDIF
139
140!!    Computation of the coastal mask.
141!!    Computation of an island mask to enhance coastal supply
142!!    of iron
143!!    -------------------------------------------------------
144
145       IF (bsedinput) THEN
146        clname='bathy.orca.nc'
147       CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,ipk      &
148    &      ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numbath)
149       CALL flinget(numbath,'bathy',jpidta,jpjdta,jpk,jpan,1,                &
150    &        1,mig(1),nlci,mjg(1),nlcj,cmask(1:nlci,1:nlcj,1:jpk) )
151       CALL flinclo(numbath)
152
153        ! Extra-halo initialization in MPP
154         IF( lk_mpp ) THEN
155            DO ji = nlci+1, jpi
156               cmask(ji,:,:) = cmask(1,:,:)
157            ENDDO
158            DO jj = nlcj+1, jpj
159               cmask(:,jj,:)=cmask(:,1,:)
160            ENDDO
161         ENDIF
162
163         DO jk = 1, jpk
164           DO jj = 1, jpj
165             DO ji = 1, jpi
166               expide=min(8.,(fsdept(ji,jj,jk)/500.)**(-1.5))
167               denitide=-0.9543+0.7662*log(expide)-0.235*log(expide)**2
168               cmask(ji,jj,jk)=cmask(ji,jj,jk)*exp(denitide)/0.6858
169             END DO
170           END DO
171         END DO
172
173       ELSE
174       cmask(:,:,:)=0.
175       ENDIF
176
177!!     Computation of the total atmospheric supply of Si
178!!     -------------------------------------------------
179
180       sumdepsi=0.
181       DO mo=1,12
182         DO jj=2,jpjm1
183           DO ji=2,jpim1
184           sumdepsi=sumdepsi+dustmo(ji,jj,mo)/(12.*rmoss)*8.8        &
185              *0.075/28.1*e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1)
186           END DO
187         END DO
188       END DO
189
190       IF( lk_mpp )   CALL mpp_sum( sumdepsi )  ! sum over the global domain
191
192!!    COMPUTATION OF THE N/P RELEASE DUE TO COASTAL RIVERS
193!!    COMPUTATION OF THE Si RELEASE DUE TO COASTAL RIVERS
194!!    ---------------------------------------------------
195
196       DO jj=1,jpj
197         DO ji=1,jpi
198       cotdep(ji,jj,1)=river(ji,jj)*1E9/(12.*raass                          &
199                       *e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)*tmask(ji,jj,1)
200       po4dep(ji,jj,1)=(river(ji,jj)+riverdoc(ji,jj))*1E9                   &
201                       /(31.6*raass*e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)   &
202                       *tmask(ji,jj,1)
203       nitdep(ji,jj,1)=7.6*ndepo(ji,jj)*tmask(ji,jj,1)/(14E6*raass          &
204                       *fse3t(ji,jj,1)+rtrn)
205         END DO
206       END DO
207
208      rivpo4input=0.
209      rivalkinput=0.
210      rivnitinput=0.
211       DO jj=2,jpjm1
212         DO ji=2,jpim1
213         rivpo4input=rivpo4input+po4dep(ji,jj,1)*(e1t(ji,jj)*e2t(ji,jj)    &
214                     *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
215         rivalkinput=rivalkinput+cotdep(ji,jj,1)*(e1t(ji,jj)*e2t(ji,jj)    &
216                     *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
217         rivnitinput=rivnitinput+nitdep(ji,jj,1)*(e1t(ji,jj)*e2t(ji,jj)    &
218                     *fse3t(ji,jj,1))*tmask(ji,jj,1)*raass
219         END DO
220       END DO
221
222        IF( lk_mpp ) THEN
223          CALL mpp_sum( rivpo4input )  ! sum over the global domain
224          CALL mpp_sum( rivalkinput )  ! sum over the global domain
225          CALL mpp_sum( rivnitinput )  ! sum over the global domain
226        ENDIF
227
228
229!!    Coastal supply of iron
230!!    ----------------------
231
232      DO jk=1,jpkm1
233          ironsed(:,:,jk)=sedfeinput*cmask(:,:,jk)         &
234                            /(fse3t(:,:,jk)*rjjss)
235      END DO
236!!----------------------------------------------------------------------
237!!
238!! Initialize biological variables
239!!
240!!----------------------------------------------------------------------
241
242      spocri = 0.003
243      jkopt = 14
244
245!! Set biological ratios
246!! ---------------------
247
248      rno3   = (16.+2.)/122.
249      po4r   = 1./122.
250      o2ut   = 172./122.
251      o2nit  = 32./122.
252      rdenit = 97.6/16.
253      o2ut   = 140./122.
254
255!!----------------------------------------------------------------------
256!!
257!! Initialize chemical variables
258!!
259!!----------------------------------------------------------------------
260
261!! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio
262!! ----------------------------------------------------------
263
264      atcox = 0.20946
265
266!! Set lower/upper limits for temperature and salinity
267!! ---------------------------------------------------
268
269      salchl = 1./1.80655
270      calcon = 1.03E-2
271
272!! Set coefficients for apparent solubility equilibrium
273!!   of calcite (Ingle, 1800, eq. 6)
274!! ----------------------------------------------------
275
276      akcc1 = -34.452
277      akcc2 = -39.866
278      akcc3 = 110.21
279      akcc4 = -7.5752E-6
280
281
282!! Set coefficients for seawater pressure correction
283!! -------------------------------------------------
284
285      devk1  = 24.2
286      devk2  = 16.4
287      devkb  = 27.5
288      devk1t = 0.085
289      devk2t = 0.04
290      devkbt = 0.095
291
292      devkst = 0.23
293      devks  = 35.4
294
295!! Set universal gas constants
296!! ---------------------------
297
298      rgas = 83.143
299      oxyco = 1./22.4144
300
301!! Set boron constants
302!! -------------------
303
304      bor1 = 0.00023
305      bor2 = 1./10.82
306
307!! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974)
308!! -----------------------------------------------------------------
309
310      c00 = -58.0931
311      c01 = 90.5069
312      c02 = 22.2940
313      c03 = 0.027766
314      c04 = -0.025888
315      c05 = 0.0050578
316
317!! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)
318!! ---------------------------------------------------------------------
319
320      c10 = -2307.1266
321      c11 = 2.83655
322      c12 = -1.5529413
323      c13 = -4.0484
324      c14 = -0.20760841
325      c15 = 0.08468345
326      c16 = -0.00654208
327      c17 = -0.001005
328
329!! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970)
330!! ---------------------------------------------------------------------
331 
332      c20 = -3351.6106
333      c21 = -9.226508
334      c22 = -0.2005743
335      c23 = -23.9722
336      c24 = -0.106901773
337      c25 = 0.1130822
338      c26 = -0.00846934
339      c27 = -0.001005
340
341!! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970)
342!! ------------------------------------------------------------------
343
344      cb0  = -8966.90
345      cb1  = -2890.53
346      cb2  = -77.942
347      cb3  = 1.728
348      cb4  = -0.0996
349      cb5  = 148.0248
350      cb6  = 137.1942
351      cb7  = 1.62142
352      cb8  = -24.4344
353      cb9  = -25.085
354      cb10 = -0.2474
355      cb11 = 0.053105
356
357!! Set coeff. for dissoc. of water (Dickson and Riley, 1979,
358!!   eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415
359!!   after pers. commun. to B. Bacastow, 1988)
360!! ---------------------------------------------------------
361
362      cw0 = -13847.26
363      cw1 = 148.9652
364      cw2 = -23.6521
365      cw3 = 118.67
366      cw4 = -5.977
367      cw5 = 1.0495
368      cw6 = -0.01615
369
370!! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970)
371!! ----------------------------------------------------------------
372
373      ox0 = -58.3877
374      ox1 = 85.8079
375      ox2 = 23.8439
376      ox3 = -0.034892
377      ox4 = 0.015568
378      ox5 = -0.0019387
379
380!!  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE
381!!  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT
382
383         open(49,file='kRGB61.txt',form='formatted')
384         do ichl=1,61
385           READ(49,*) xtoto,(xkrgb(iband,ichl),iband = 1,3)
386         end do
387         close(49)
388     
389#if defined key_off_degrad
390
391!! Read volume for degraded regions (DEGINIT)
392!! ------------------------------------------
393
394#    if defined key_vpp
395      CALL READ3S(902,facvol,jpi,jpj,jpk)
396#    else
397      READ (902) facvol
398#    endif
399#endif
400
401
402!!  Call p4zche to initialize the chemical constants
403!!  ------------------------------------------------
404
405      CALL p4zche
406
407      IF(lwp) WRITE(numout,*) ' Initialisation of PISCES done'
Note: See TracBrowser for help on using the repository browser.