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

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

nemo_v1_update_005:RB: update headers for the TOP component.

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