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.
p2zexp.F90 in NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/TOP/PISCES/P2Z/p2zexp.F90 @ 9939

Last change on this file since 9939 was 9939, checked in by gm, 6 years ago

#1911 (ENHANCE-04): RK3 branche phased with MLF@9937 branche

  • Property svn:keywords set to Id
File size: 10.3 KB
Line 
1MODULE p2zexp
2   !!======================================================================
3   !!                         ***  MODULE p2zsed  ***
4   !! TOP :   LOBSTER Compute loss of organic matter in the sediments
5   !!======================================================================
6   !! History :   -   !  1999    (O. Aumont, C. Le Quere)  original code
7   !!             -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations
8   !!            1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc
9   !!            2.0  !  2007-12  (C. Deltel, G. Madec)  F90
10   !!            3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   p2z_exp       :  Compute loss of organic matter in the sediments
15   !!----------------------------------------------------------------------
16   USE oce_trc        !
17   USE trc            !
18   USE sms_pisces     !
19   USE p2zsed         !
20   USE lbclnk         !
21   USE prtctl_trc     ! Print control for debbuging
22   USE trd_oce        !
23   USE trdtrc         !
24   USE iom            !
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   p2z_exp   
30   PUBLIC   p2z_exp_init 
31   PUBLIC   p2z_exp_alloc
32
33   !
34   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   dminl     ! fraction of sinking POC released in sediments
35   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   dmin3     ! fraction of sinking POC released at each level
36   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocb   ! mass of POC in sediments
37   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocn   ! mass of POC in sediments
38   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   cmask     ! Coastal mask area
39   REAL(wp)                                ::   areacot   ! surface coastal area
40
41   !! * Substitutions
42#  include "vectopt_loop_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 3.3 , NEMO Consortium (2018)
45   !! $Id$
46   !! Software governed by the CeCILL licence (./LICENSE)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE p2z_exp( kt )
51      !!---------------------------------------------------------------------
52      !!                     ***  ROUTINE p2z_exp  ***
53      !!
54      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
55      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
56      !!
57      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
58      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
59      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION.
60      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
61      !!              COLUMN BELOW THE SURFACE LAYER.
62      !!---------------------------------------------------------------------
63      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index     
64      !!
65      INTEGER  ::   ji, jj, jk, jl, ikt
66      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
67      REAL(wp), DIMENSION(jpi,jpj)   ::  zsedpoca
68      CHARACTER (len=25) ::   charout
69      !!---------------------------------------------------------------------
70      !
71      IF( ln_timing )   CALL timing_start('p2z_exp')
72      !
73      IF( kt == nittrc000 )   CALL p2z_exp_init
74
75      zsedpoca(:,:) = 0._wp
76
77
78      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC POC IN THE WATER COLUMN
79      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
80      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90
81      ! ----------------------------------------------------------------------
82      DO jk = 1, jpkm1
83         DO jj = 2, jpjm1
84            DO ji = fs_2, fs_jpim1
85               ze3t = 1. / e3t_n(ji,jj,jk)
86               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
87            END DO
88         END DO
89      END DO
90
91      ! Find the last level of the water column
92      ! Compute fluxes due to sinking particles (slow)
93   
94
95      zgeolpoc = 0._wp        !     Initialization
96      DO jj = 2, jpjm1           ! Release of nutrients from the "simple" sediment
97         DO ji = fs_2, fs_jpim1
98            ikt = mbkt(ji,jj) 
99            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / e3t_n(ji,jj,ikt) 
100            ! Deposition of organic matter in the sediment
101            zwork = vsed * trn(ji,jj,ikt,jpdet)
102            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
103               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt
104            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
105         END DO
106      END DO
107
108      DO jj = 2, jpjm1
109         DO ji = fs_2, fs_jpim1
110            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / e3t_n(ji,jj,1)
111         END DO
112      END DO
113
114      CALL lbc_lnk( sedpocn, 'T', 1. )
115 
116      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
117      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn )
118
119     
120      ! Time filter and swap of arrays
121      ! ------------------------------
122      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step   (only swap)
123        sedpocn(:,:) = zsedpoca(:,:)
124        !                                             
125      ELSE                          ! Leap-Frog + Asselin filter
126        !
127        DO jj = 1, jpj
128           DO ji = 1, jpi
129              zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)     ! time laplacian on tracers
130              sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                  ! sedpocb <-- filtered sedpocn
131              sedpocn(ji,jj) = zsedpoca(ji,jj)                                      ! sedpocn <-- sedpoca
132           END DO
133        END DO
134        !
135      ENDIF
136      !
137      IF( lrst_trc ) THEN
138         IF(lwp) WRITE(numout,*)
139         IF(lwp) WRITE(numout,*) 'p2z_exp : POC in sediment fields written in ocean restart file ',   &
140            &                    'at it= ', kt,' date= ', ndastp
141         IF(lwp) WRITE(numout,*) '~~~~'
142         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
143         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
144      ENDIF
145      !
146      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
147         WRITE(charout, FMT="('exp')")
148         CALL prt_ctl_trc_info(charout)
149         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
150      ENDIF
151      !
152      IF( ln_timing )  CALL timing_stop('p2z_exp')
153      !
154   END SUBROUTINE p2z_exp
155
156
157   SUBROUTINE p2z_exp_init
158      !!----------------------------------------------------------------------
159      !!                    ***  ROUTINE p4z_exp_init  ***
160      !! ** purpose :   specific initialisation for export
161      !!----------------------------------------------------------------------
162      INTEGER  ::   ji, jj, jk
163      REAL(wp) ::   zmaskt, zfluo, zfluu
164      REAL(wp), DIMENSION(jpi,jpj    ) :: zrro
165      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0
166      !!---------------------------------------------------------------------
167      !
168      IF(lwp) THEN
169         WRITE(numout,*)
170         WRITE(numout,*) ' p2z_exp: LOBSTER export'
171         WRITE(numout,*) ' ~~~~~~~'
172         WRITE(numout,*) '  compute remineralisation-damping arrays for tracers'
173      ENDIF
174      !
175
176      ! Calculate vertical distribution of newly formed biogenic poc
177      ! in the water column in the case of max. possible bottom depth
178      ! ------------------------------------------------------------
179      zdm0 = 0._wp
180      zrro = 1._wp
181      DO jk = jpkb, jpkm1
182         DO jj = 1, jpj
183            DO ji = 1, jpi
184               zfluo = ( gdepw_n(ji,jj,jk  ) / gdepw_n(ji,jj,jpkb) )**xhr
185               zfluu = ( gdepw_n(ji,jj,jk+1) / gdepw_n(ji,jj,jpkb) )**xhr
186               IF( zfluo.GT.1. )   zfluo = 1._wp
187               zdm0(ji,jj,jk) = zfluo - zfluu
188               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
189               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
190            END DO
191         END DO
192      END DO
193      !
194      zdm0(:,:,jpk) = zrro(:,:)
195
196      ! Calculate vertical distribution of newly formed biogenic poc
197      ! in the water column with realistic topography (first "dry" layer
198      ! contains total fraction, which has passed to the upper layers)
199      ! ----------------------------------------------------------------------
200      dminl(:,:)   = 0._wp
201      dmin3(:,:,:) = zdm0
202      DO jk = 1, jpk
203         DO jj = 1, jpj
204            DO ji = 1, jpi
205               IF( tmask(ji,jj,jk) == 0._wp ) THEN
206                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
207                  dmin3(ji,jj,jk) = 0._wp
208               ENDIF
209            END DO
210         END DO
211      END DO
212
213      DO jj = 1, jpj
214         DO ji = 1, jpi
215            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
216         END DO
217      END DO
218
219      ! Coastal mask
220      cmask(:,:) = 0._wp
221      DO jj = 2, jpjm1
222         DO ji = fs_2, fs_jpim1
223            IF( tmask(ji,jj,1) /= 0. ) THEN
224               zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
225               IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
226            END IF
227         END DO
228      END DO
229      CALL lbc_lnk( cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
230      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) )
231      !
232      IF( ln_rsttr ) THEN
233         CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
234         CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
235      ELSE
236         sedpocb(:,:) = 0._wp
237         sedpocn(:,:) = 0._wp
238      ENDIF
239      !
240   END SUBROUTINE p2z_exp_init
241
242   INTEGER FUNCTION p2z_exp_alloc()
243      !!----------------------------------------------------------------------
244      !!                     ***  ROUTINE p2z_exp_alloc  ***
245      !!----------------------------------------------------------------------
246      ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
247         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj),   STAT=p2z_exp_alloc )
248      IF( p2z_exp_alloc /= 0 ) CALL ctl_warn('p2z_exp_alloc : failed to allocate arrays.')
249      !
250   END FUNCTION p2z_exp_alloc
251
252   !!======================================================================
253END MODULE p2zexp
Note: See TracBrowser for help on using the repository browser.