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

source: trunk/NEMO/TOP_SRC/SMS/trcini.lobster1.h @ 186

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

CL + CE : NEMO TRC_SRC start

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