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

source: trunk/NEMO/TOP_SRC/SMS/trcini.lobster1.h90 @ 336

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

nemo_v1_update_024 : CE + RB + CT : new evolution of modules

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 KB
Line 
1   !!----------------------------------------------------------------------
2   !!                    ***  trcini.lobster1.h90 ***
3   !!----------------------------------------------------------------------
4#  include "domzgr_substitute.h90"
5#  include "passivetrc_substitute.h90"
6CONTAINS
7
8   SUBROUTINE trc_ini
9      !!---------------------------------------------------------------------
10      !!                    ***  ROUTINE trc_ini  ***
11      !!  purpose :
12      !!  ---------
13      !!     specific initialisation for lobster1 model
14      !!
15      !!   History :
16      !!   --------
17      !!      original    : 99-09 (M. Levy)
18      !!      additions   : 00-12 (0. Aumont, E. Kestenare)
19      !!                           add sediment computations
20      !!    03-05 : O. Aumont and A. El Moussaoui F90 
21      !!---------------------------------------------------------------------
22      !! local declarations
23      !! ==================
24      INTEGER ji,jj,jk,jn
25      REAL zdm0(jpi,jpj,jpk),zrro(jpi,jpj),zfluo,zfluu
26      REAL ztest
27
28      !! 1. initialization of fields for optical model
29      !! --------------------------------------------
30
31      xze(:,:)=5.
32      xpar(:,:,:)=0.
33
34      !! 2. initialization for passive tracer remineralisation-damping  array
35      !! -------------------------------------------------------------------------
36
37      DO jn=1,jptra
38         remdmp(:,jn)=tminr
39      END DO
40
41      IF(lwp) THEN
42         WRITE(numout,*) ' '
43         WRITE(numout,*) ' trcini: compute remineralisation-damping  '
44         WRITE(numout,*) '         arrays for tracers'
45      ENDIF
46
47      !! 3. initialization of biological variables
48      !! ------------------------------------------
49
50      !! Calculate vertical distribution of newly formed biogenic poc
51      !! in the water column in the case of max. possible bottom depth
52      !! ------------------------------------------------------------
53
54      zdm0   = 0.
55      zrro = 1.
56      DO jk = jpkb,jpkm1
57         DO jj =1, jpj
58            DO ji =1, jpi
59               zfluo = (fsdepw(ji,jj,jk)/fsdepw(ji,jj,jpkb))**xhr
60               zfluu = (fsdepw(ji,jj,jk+1)/fsdepw(ji,jj,jpkb))**xhr
61               IF (zfluo.GT.1.) zfluo = 1.
62               zdm0(ji,jj,jk) = zfluo-zfluu
63               IF (jk.LE.jpkb-1) zdm0(ji,jj,jk)=0.
64               zrro(ji,jj) = zrro(ji,jj)-zdm0(ji,jj,jk)
65            ENDDO
66         ENDDO
67      ENDDO
68!!!
69
70      zdm0(:,:,jpk) = zrro(:,:)
71
72      !! Calculate vertical distribution of newly formed biogenic poc
73      !! in the water column with realistic topography (first "dry" layer
74      !! contains total fraction, which has passed to the upper layers)
75      !! ----------------------------------------------------------------------
76
77      dminl = 0.
78      dmin3 = zdm0
79
80      DO jk = 1,jpk
81         DO jj = 1,jpj
82            DO ji = 1,jpi
83
84               IF(tmask(ji,jj,jk) == 0) THEN
85                  dminl(ji,jj) = dminl(ji,jj)+dmin3(ji,jj,jk)
86                  dmin3(ji,jj,jk) = 0.0
87               ENDIF
88
89            ENDDO
90         ENDDO
91      ENDDO
92
93      DO jj = 1,jpj
94         DO ji = 1,jpi
95            IF (tmask(ji,jj,1) == 0) dmin3(ji,jj,1) = 0.
96         ENDDO
97      ENDDO
98
99      !! CALCUL DU MASK DE COTE
100      !! ----------------------   
101      cmask=0.
102      do ji=2,jpi-1
103         do jj=2,jpj-1
104            if (tmask(ji,jj,1) == 1) then
105               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1)
106               IF (ztest == 0) cmask(ji,jj) = 1.
107            endif
108         end do
109      end do
110
111      cmask(1,:)=cmask(jpi-1,:)
112      cmask(jpi,:)=cmask(2,:)
113
114
115      !! CALCUL DE LA SURFACE COTIERE
116      !! ----------------------------
117      areacot=0.
118      do ji=2,jpi-1
119         do jj=2,jpj-1
120            areacot=areacot+e1t(ji,jj)*e2t(ji,jj)*cmask(ji,jj)
121         end do
122      end do
123
124   END SUBROUTINE trc_ini
Note: See TracBrowser for help on using the repository browser.