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.
p4zsms.F90 in branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 @ 3443

Last change on this file since 3443 was 3443, checked in by cetlod, 12 years ago

branch:2012/dev_r3438_LOCEAN15_PISLOB : 1st step of the merge, see ticket #972
File size: 22.8 KB
Line 
1MODULE p4zsms
2   !!======================================================================
3   !!                         ***  MODULE p4zsms  ***
4   !! TOP :   PISCES Source Minus Sink manager
5   !!======================================================================
6   !! History :   1.0  !  2004-03 (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!----------------------------------------------------------------------
9#if defined key_pisces
10   !!----------------------------------------------------------------------
11   !!   'key_pisces'                                       PISCES bio-model
12   !!----------------------------------------------------------------------
13   !!   p4zsms        :  Time loop of passive tracers sms
14   !!----------------------------------------------------------------------
15   USE oce_trc         !  shared variables between ocean and passive tracers
16   USE trc             !  passive tracers common variables
17   USE trcdta
18   USE sms_pisces      !  PISCES Source Minus Sink variables
19   USE p4zbio          !  Biological model
20   USE p4zche          !  Chemical model
21   USE p4zlys          !  Calcite saturation
22   USE p4zflx          !  Gas exchange
23   USE p4zsbc          !  External source of nutrients
24   USE p4zsed          !  Sedimentation
25   USE p4zint          !  time interpolation
26   USE iom             !  I/O manager
27   USE trdmod_oce      !  Ocean trends variables
28   USE trdmod_trc      !  TOP trends variables
29   USE sedmodel        !  Sediment model
30   USE prtctl_trc      !  print control for debugging
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   p4z_sms_init    ! called in p4zsms.F90
36   PUBLIC   p4z_sms    ! called in p4zsms.F90
37
38   LOGICAL ::  ln_check_mass = .false.       !: Flag to check mass conservation
39
40   INTEGER ::  numno3  !: logical unit for NO3 budget
41   INTEGER ::  numalk  !: logical unit for talk budget
42   INTEGER ::  numsil  !: logical unit for Si budget
43
44   !!----------------------------------------------------------------------
45   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
46   !! $Id: p4zsms.F90 3320 2012-03-05 16:37:52Z cetlod $
47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52   SUBROUTINE p4z_sms( kt )
53      !!---------------------------------------------------------------------
54      !!                     ***  ROUTINE p4z_sms  ***
55      !!
56      !! ** Purpose :   Managment of the call to Biological sources and sinks
57      !!              routines of PISCES bio-model
58      !!
59      !! ** Method  : - at each new day ...
60      !!              - several calls of bio and sed ???
61      !!              - ...
62      !!---------------------------------------------------------------------
63      !
64      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
65      !!
66      INTEGER ::   jnt, jn, jl
67      CHARACTER (len=25) :: charout
68      REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis
69      !!---------------------------------------------------------------------
70      !
71      IF( nn_timing == 1 )  CALL timing_start('p4z_sms')
72      !
73      IF( l_trdtrc )  THEN
74         CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
75         DO jn = 1, jp_pisces
76            jl = jn + jp_pcs0 - 1
77            ztrdpis(:,:,:,jn) = trn(:,:,:,jl)
78         ENDDO
79      ENDIF
80      !
81      IF( ln_rsttr .AND. kt == nittrc000 )                         CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields
82      IF( ln_rsttr  .AND. ln_pisclo )                              CALL p4z_clo            ! damping on closed seas
83      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
84                                                                   CALL p4z_chk_mass( kt ) ! Mass conservation checking
85      IF( ndayflxtr /= nday_year ) THEN      ! New days
86         !
87         ndayflxtr = nday_year
88
89         IF(lwp) write(numout,*)
90         IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
91         IF(lwp) write(numout,*) '~~~~~~'
92
93         CALL p4z_che              ! computation of chemical constants
94         CALL p4z_int( kt )        ! computation of various rates for biogeochemistry
95         !
96      ENDIF
97
98      IF( ll_sbc ) CALL p4z_sbc( kt )   ! external sources of nutrients
99
100      DO jnt = 1, nrdttrc          ! Potential time splitting if requested
101         !
102         CALL p4z_bio (kt, jnt)    ! Biology
103         CALL p4z_sed (kt, jnt)    ! Sedimentation
104         !
105         DO jn = jp_pcs0, jp_pcs1
106            trb(:,:,:,jn) = trn(:,:,:,jn)
107         ENDDO
108         !
109      END DO
110
111      IF( l_trdtrc )  THEN
112         DO jn = 1, jp_pisces
113            jl = jn + jp_pcs0 - 1
114            ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r
115         ENDDO
116      ENDIF
117
118      CALL p4z_lys( kt )             ! Compute CaCO3 saturation
119      CALL p4z_flx( kt )             ! Compute surface fluxes
120
121      DO jn = jp_pcs0, jp_pcs1
122        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
123        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
124        CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
125      END DO
126      !
127      IF( lk_sed ) THEN 
128         !
129         CALL sed_model( kt )     !  Main program of Sediment model
130         !
131         DO jn = jp_pcs0, jp_pcs1
132           CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
133         END DO
134         !
135      ENDIF
136      !
137      IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file
138      !
139      IF( l_trdtrc ) THEN
140         DO jn = 1, jp_pisces
141            jl = jn + jp_pcs0 - 1
142             ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl)
143             CALL trd_mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends
144          END DO
145          CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
146      END IF
147      !
148      IF( nn_timing == 1 )  CALL timing_stop('p4z_sms')
149      !
150   END SUBROUTINE p4z_sms
151
152   SUBROUTINE p4z_sms_init
153      !!----------------------------------------------------------------------
154      !!                     ***  p4z_sms_init  *** 
155      !!
156      !! ** Purpose :   read PISCES namelist
157      !!
158      !! ** input   :   file 'namelist.trc.s' containing the following
159      !!             namelist: natext, natbio, natsms
160      !!                       natkriest ("key_kriest")
161      !!----------------------------------------------------------------------
162      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max
163#if defined key_kriest
164      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max
165#endif
166      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo
167
168      REWIND( numnatp )
169      READ  ( numnatp, nampisbio )
170
171      IF(lwp) THEN                         ! control print
172         WRITE(numout,*) ' Namelist : nampisbio'
173         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc
174         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio
175         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort
176         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
177         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
178         WRITE(numout,*) '    Maximum number of iterations for POC      niter1max =', niter1max
179         WRITE(numout,*) '    Maximum number of iterations for GOC      niter2max =', niter2max
180      ENDIF
181
182#if defined key_kriest
183
184      !                               ! nampiskrp : kriest parameters
185      !                               ! -----------------------------
186      xkr_eta      = 0.62
187      xkr_zeta     = 1.62
188      xkr_ncontent = 5.7E-6
189      xkr_mass_min = 0.0002
190      xkr_mass_max = 1.
191
192      REWIND( numnatp )                     ! read natkriest
193      READ  ( numnatp, nampiskrp )
194
195      IF(lwp) THEN
196         WRITE(numout,*)
197         WRITE(numout,*) ' Namelist : nampiskrp'
198         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta
199         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
200         WRITE(numout,*) '    N content factor                         xkr_ncontent = ', xkr_ncontent
201         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
202         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
203         WRITE(numout,*)
204     ENDIF
205
206
207     ! Computation of some variables
208     xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta
209
210#endif
211
212      REWIND( numnatp )
213      READ  ( numnatp, nampisdmp )
214
215      IF(lwp) THEN                         ! control print
216         WRITE(numout,*)
217         WRITE(numout,*) ' Namelist : nampisdmp'
218         WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp
219         WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp
220         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo
221         WRITE(numout,*) ' '
222      ENDIF
223
224   END SUBROUTINE p4z_sms_init
225
226   SUBROUTINE p4z_rst( kt, cdrw )
227      !!---------------------------------------------------------------------
228      !!                   ***  ROUTINE p4z_rst  ***
229      !!
230      !!  ** Purpose : Read or write variables in restart file:
231      !!
232      !!  WRITE(READ) mode:
233      !!       kt        : number of time step since the begining of the experiment at the
234      !!                   end of the current(previous) run
235      !!---------------------------------------------------------------------
236      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
237      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
238      !
239      INTEGER  ::  ji, jj, jk
240      REAL(wp) ::  zcaralk, zbicarb, zco3
241      REAL(wp) ::  ztmas, ztmas1
242      !!---------------------------------------------------------------------
243
244      IF( TRIM(cdrw) == 'READ' ) THEN
245         !
246         IF(lwp) WRITE(numout,*)
247         IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
248         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
249         !
250         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
251            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  )
252         ELSE
253!            hi(:,:,:) = 1.e-9
254            ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???)
255            ! --------------------------------------------------------
256            DO jk = 1, jpk
257               DO jj = 1, jpj
258                  DO ji = 1, jpi
259                     ztmas   = tmask(ji,jj,jk)
260                     ztmas1  = 1. - tmask(ji,jj,jk)
261                     zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
262                     zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
263                     zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
264                     hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
265                  END DO
266               END DO
267            END DO
268         ENDIF
269         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
270         IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
271            CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
272         ELSE
273            xksimax(:,:) = xksi(:,:)
274         ENDIF
275         !
276      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
277         IF( kt == nitrst ) THEN
278            IF(lwp) WRITE(numout,*)
279            IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file  kt =', kt
280            IF(lwp) WRITE(numout,*) '~~~~~~~'
281         ENDIF
282         CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
283         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
284         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
285      ENDIF
286      !
287   END SUBROUTINE p4z_rst
288
289   SUBROUTINE p4z_dmp( kt )
290      !!----------------------------------------------------------------------
291      !!                    ***  p4z_dmp  ***
292      !!
293      !! ** purpose  : Relaxation of some tracers
294      !!----------------------------------------------------------------------
295      !
296      INTEGER, INTENT( in )  ::     kt ! time step
297      !
298      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
299      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates
300      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate
301      REAL(wp) ::  silmean = 91.51     ! mean value of silicate
302      !
303      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum
304      !!---------------------------------------------------------------------
305
306
307      IF(lwp)  WRITE(numout,*)
308      IF(lwp)  WRITE(numout,*) ' p4z_dmp : Relaxation of nutrients at time-step kt = ', kt
309      IF(lwp)  WRITE(numout,*)
310
311      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) !
312         !                                                    ! --------------------------- !
313         ! set total alkalinity, phosphate, nitrate & silicate
314         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6             
315
316         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
317         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
318         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
319         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
320 
321         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
322         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
323
324         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum
325         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
326
327         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum
328         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
329
330         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum
331         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
332         !
333      ENDIF
334
335   END SUBROUTINE p4z_dmp
336
337
338   SUBROUTINE p4z_chk_mass( kt )
339      !!----------------------------------------------------------------------
340      !!                  ***  ROUTINE p4z_chk_mass  ***
341      !!
342      !! ** Purpose :  Mass conservation check
343      !!
344      !!---------------------------------------------------------------------
345      !
346      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
347      !!
348      REAL(wp) :: zalkbudget, zno3budget, zsilbudget
349      !
350      NAMELIST/nampismass/ ln_check_mass
351      !!---------------------------------------------------------------------
352
353      IF( kt == nittrc000 ) THEN
354         REWIND( numnatp )       
355         READ  ( numnatp, nampismass )
356         IF(lwp) THEN                         ! control print
357            WRITE(numout,*) ' '
358            WRITE(numout,*) ' Namelist parameter for mass conservation checking'
359            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
360            WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
361         ENDIF
362
363         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si
364            CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
365            CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
366            CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
367         ENDIF
368      ENDIF
369
370      IF( ln_check_mass ) THEN      !   Compute the budget of NO3, ALK, Si
371         zno3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  &
372            &                     + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
373            &                     + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
374            &                     + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  &
375            &                     + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  ) 
376         !
377         zsilbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  &
378            &                     + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  )
379         !
380         zalkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              &
381            &                     + trn(:,:,:,jptal)                     &
382            &                     + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  )
383
384         IF( lwp ) THEN
385            WRITE(numno3,9500) kt,  zno3budget / areatot
386            WRITE(numsil,9500) kt,  zsilbudget / areatot
387            WRITE(numalk,9500) kt,  zalkbudget / areatot
388         ENDIF
389       ENDIF
390 9500  FORMAT(i10,e18.10)     
391       !
392   END SUBROUTINE p4z_chk_mass
393
394   SUBROUTINE p4z_clo   
395      !!---------------------------------------------------------------------
396      !!                  ***  ROUTINE p4z_clo  ***
397      !!
398      !! ** Purpose :   Closed sea domain initialization
399      !!
400      !! ** Method  :   if a closed sea is located only in a model grid point
401      !!                we restore to initial data
402      !!
403      !! ** Action  :   ictsi1(), ictsj1() : south-west closed sea limits (i,j)
404      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j)
405      !!----------------------------------------------------------------------
406      INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea
407      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j)
408      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j)
409      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices
410      INTEGER :: ierr                                       ! local integer
411      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta     ! 4D  workspace
412      !!----------------------------------------------------------------------
413
414      IF(lwp) WRITE(numout,*)
415      IF(lwp) WRITE(numout,*)' p4z_clo : closed seas '
416      IF(lwp) WRITE(numout,*)'~~~~~~~'
417
418      ! initial values
419      ictsi1(:) = 1  ;  ictsi2(:) = 1 
420      ictsj1(:) = 1  ;  ictsj2(:) = 1 
421
422      ! set the closed seas (in data domain indices)
423      ! -------------------
424
425      IF( cp_cfg == "orca" ) THEN
426         !
427         SELECT CASE ( jp_cfg )
428         !                                           ! =======================
429         CASE ( 2 )                                  !  ORCA_R2 configuration
430            !                                        ! =======================
431            !                                            ! Caspian Sea
432            ictsi1(1)   =  11  ;  ictsj1(1)   = 103
433            ictsi2(1)   =  17  ;  ictsj2(1)   = 112
434            !                                            ! Great North American Lakes
435            ictsi1(2)   =  97  ;  ictsj1(2)   = 107
436            ictsi2(2)   = 103  ;  ictsj2(2)   = 111
437            !                                            ! Black Sea 1 : west part of the Black Sea
438            ictsi1(3)   = 174  ; ictsj1(3)   = 107
439            ictsi2(3)   = 181  ; ictsj2(3)   = 112
440            !                                            ! Black Sea 2 : est part of the Black Sea
441            ictsi1(4)   =   2  ;  ictsj1(4)   = 107
442            ictsi2(4)   =   6  ;  ictsj2(4)   = 112
443            !                                        ! =======================
444         CASE ( 4 )                                  !  ORCA_R4 configuration
445            !                                        ! =======================
446            !                                            ! Caspian Sea
447            ictsi1(1)   =  4  ;  ictsj1(1)   = 53
448            ictsi2(1)   =  4  ;  ictsj2(1)   = 56
449            !                                            ! Great North American Lakes
450            ictsi1(2)   = 49  ;  ictsj1(2)   = 55
451            ictsi2(2)   = 51  ;  ictsj2(2)   = 56
452            !                                            ! Black Sea
453            ictsi1(3)   = 88  ;  ictsj1(3)   = 55
454            ictsi2(3)   = 91  ;  ictsj2(3)   = 56
455            !                                            ! Baltic Sea
456            ictsi1(4)   = 75  ;  ictsj1(4)   = 59
457            ictsi2(4)   = 76  ;  ictsj2(4)   = 61
458            !                                        ! =======================
459            !                                        ! =======================
460         CASE ( 025 )                                ! ORCA_R025 configuration
461            !                                        ! =======================
462                                                     ! Caspian + Aral sea
463            ictsi1(1)   = 1330 ; ictsj1(1)   = 645
464            ictsi2(1)   = 1400 ; ictsj2(1)   = 795
465            !                                        ! Azov Sea
466            ictsi1(2)   = 1284 ; ictsj1(2)   = 722
467            ictsi2(2)   = 1304 ; ictsj2(2)   = 747
468            !
469         END SELECT
470         !
471      ENDIF
472
473      ! convert the position in local domain indices
474      ! --------------------------------------------
475      DO jc = 1, npicts 
476         ictsi1(jc)   = mi0( ictsi1(jc) )
477         ictsj1(jc)   = mj0( ictsj1(jc) )
478
479         ictsi2(jc)   = mi1( ictsi2(jc) )
480         ictsj2(jc)   = mj1( ictsj2(jc) )
481      END DO
482
483      ! Restore close seas values to initial data
484      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping
485         !
486         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )   ! Memory allocation
487         !
488         CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000
489         !
490         DO jn = 1, jptra
491            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
492                jl = n_trc_index(jn)
493                DO jc = 1, npicts
494                   DO jk = 1, jpkm1
495                      DO jj = ictsj1(jc), ictsj2(jc)
496                         DO ji = ictsi1(jc), ictsi2(jc)
497                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)
498                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
499                         ENDDO
500                      ENDDO
501                   ENDDO
502                ENDDO
503             ENDIF
504          ENDDO
505          CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
506      ENDIF
507      !
508   END SUBROUTINE p4z_clo
509#else
510   !!======================================================================
511   !!  Dummy module :                                   No PISCES bio-model
512   !!======================================================================
513CONTAINS
514   SUBROUTINE p4z_sms( kt )                   ! Empty routine
515      INTEGER, INTENT( in ) ::   kt
516      WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt
517   END SUBROUTINE p4z_sms
518#endif 
519
520   !!======================================================================
521END MODULE p4zsms 
Note: See TracBrowser for help on using the repository browser.