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_lobster.F90 in branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90 @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.7 KB
Line 
1MODULE trcini_lobster
2   !!======================================================================
3   !!                         ***  MODULE trcini_lobster  ***
4   !! TOP :   initialisation of the LOBSTER biological model
5   !!======================================================================
6   !! History :    -   !  1999-09  (M. Levy) Original code
7   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment
8   !!             1.0  !  2004-03  (C. Ethe) Modularity
9   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
10   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.lobster1.h90
11   !!----------------------------------------------------------------------
12#if defined key_lobster
13   !!----------------------------------------------------------------------
14   !!   'key_lobster'                                     LOBSTER bio-model
15   !!----------------------------------------------------------------------
16   !! trc_ini_lobster  : LOBSTER model initialisation
17   !!----------------------------------------------------------------------
18   USE par_trc         ! TOP parameters
19   USE trccfc          ! CFC sms trends
20   USE sms             ! Source Minus Sink variables
21   USE oce_trc         ! ocean variables
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_ini_lobster   ! called by trcini.F90 module
27
28#  include "domzgr_substitute.h90"
29#  include "passivetrc_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
32   !! $Id$
33   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35
36CONTAINS
37
38   SUBROUTINE trc_ini_lobster
39      !!----------------------------------------------------------------------
40      !!                    ***  ROUTINE trc_ini_lobster  ***
41      !! ** purpose :   specific initialisation for LOBSTER bio-model
42      !!----------------------------------------------------------------------
43      INTEGER  ::   ji, jj, jk, jn
44      REAL(wp) ::   ztest, zfluo, zfluu
45      REAL(wp), DIMENSION(jpi,jpj)     ::   zrro
46      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdm0
47      !!----------------------------------------------------------------------
48
49      IF(lwp) WRITE(numout,*)
50      IF(lwp) WRITE(numout,*) ' trc_ini_lobster :   LOBSTER biochemical model initialisation'
51      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
52
53
54      ! initialization of fields for optical model
55      ! --------------------------------------------
56      xze (:,:)   = 5.e0
57      xpar(:,:,:) = 0.e0
58
59      ! initialization for passive tracer remineralisation-damping  array
60      ! -----------------------------------------------------------------
61
62      DO jn = 1, jptra
63         remdmp(:,jn) = tminr
64      END DO
65
66      IF(lwp) THEN
67         WRITE(numout,*) ' '
68         WRITE(numout,*) ' trcini: compute remineralisation-damping  '
69         WRITE(numout,*) '         arrays for tracers'
70      ENDIF
71
72      ! initialization of biological variables
73      ! ------------------------------------------
74
75      ! Calculate vertical distribution of newly formed biogenic poc
76      ! in the water column in the case of max. possible bottom depth
77      ! ------------------------------------------------------------
78
79      zdm0   = 0.e0
80      zrro = 1.e0
81      DO jk = jpkb,jpkm1
82         DO jj =1, jpj
83            DO ji =1, jpi
84               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr 
85               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr
86               IF( zfluo.GT.1. )   zfluo = 1.e0
87               zdm0(ji,jj,jk) = zfluo - zfluu
88               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0
89               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
90            END DO
91         END DO
92      END DO
93
94      zdm0(:,:,jpk) = zrro(:,:)
95
96      ! Calculate vertical distribution of newly formed biogenic poc
97      ! in the water column with realistic topography (first "dry" layer
98      ! contains total fraction, which has passed to the upper layers)
99      ! ----------------------------------------------------------------------
100      dminl = 0.
101      dmin3 = zdm0
102      DO jk = 1, jpk
103         DO jj = 1, jpj
104            DO ji = 1, jpi
105               IF( tmask(ji,jj,jk) == 0. ) THEN
106                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
107                  dmin3(ji,jj,jk) = 0.e0
108               ENDIF
109            END DO
110         END DO
111      END DO
112
113      DO jj = 1, jpj
114         DO ji = 1, jpi
115            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0.e0
116         END DO
117      END DO
118
119      ! Coastal mask
120      ! ------------   
121      cmask = 0.e0
122      DO ji = 2, jpi-1
123         DO jj = 2, jpj-1
124            if (tmask(ji,jj,1) == 1) then
125               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1)
126               IF (ztest == 0) cmask(ji,jj) = 1.
127            endif
128         END DO
129      END DO
130
131      cmask( 1 ,:) = cmask(jpi-1,:)
132      cmask(jpi,:) = cmask( 2   ,:)
133
134      !!gm BUG !!!!!   not valid in mpp and also not valid for north fold   !!!!!
135
136      ! Coastal surface
137      ! ---------------
138      areacot = 0.e0
139      DO ji = 2, jpi-1
140         DO jj = 2, jpj-1
141            areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj)
142         END DO
143      END DO
144      !
145   END SUBROUTINE trc_ini_lobster
146
147#else
148   !!----------------------------------------------------------------------
149   !!   Dummy module                                   No LOBSTER bio-model
150   !!----------------------------------------------------------------------
151CONTAINS
152   SUBROUTINE trc_ini_lobster             ! Empty routine
153   END SUBROUTINE trc_ini_lobster
154#endif
155
156   !!======================================================================
157END MODULE trcini_lobster
Note: See TracBrowser for help on using the repository browser.