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 branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 11.9 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#if defined key_pisces_reduced
13   !!----------------------------------------------------------------------
14   !!   'key_pisces_reduced'                                     LOBSTER bio-model
15   !!----------------------------------------------------------------------
16   !!   p2z_exp        :  Compute loss of organic matter in the sediments
17   !!----------------------------------------------------------------------
18   USE oce_trc         !
19   USE trc
20   USE sms_pisces
21   USE p2zsed
22   USE lbclnk
23   USE prtctl_trc      ! Print control for debbuging
24   USE trd_oce
25   USE trdtrc
26   USE iom
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   p2z_exp   
32   PUBLIC   p2z_exp_init 
33   PUBLIC   p2z_exp_alloc
34
35   !
36   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments
37   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level
38   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments
39   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments
40   REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   cmask     !: Coastal mask area
41   REAL(wp)                                ::   areacot   !: surface coastal area
42
43   !! * Substitutions
44#  include "domzgr_substitute.h90"
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51
52CONTAINS
53
54   SUBROUTINE p2z_exp( kt )
55      !!---------------------------------------------------------------------
56      !!                     ***  ROUTINE p2z_exp  ***
57      !!
58      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
59      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
60      !!
61      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
62      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
63      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION.
64      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
65      !!              COLUMN BELOW THE SURFACE LAYER.
66      !!---------------------------------------------------------------------
67      !!
68      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
69      !!
70      INTEGER  ::   ji, jj, jk, jl, ikt
71      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
72      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrbio
73      REAL(wp), POINTER, DIMENSION(:,:)   ::  zsedpoca
74      CHARACTER (len=25) :: charout
75      !!---------------------------------------------------------------------
76      !
77      IF( nn_timing == 1 )  CALL timing_start('p2z_exp')
78      !
79      IF( kt == nittrc000 )   CALL p2z_exp_init
80
81      CALL wrk_alloc( jpi, jpj, zsedpoca ) 
82      zsedpoca(:,:) = 0.
83
84      IF( l_trdtrc )  THEN
85         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends
86         ztrbio(:,:,:) = tra(:,:,:,jpno3)
87      ENDIF
88
89      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
90      ! POC IN THE WATER COLUMN
91      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
92      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90
93      ! ----------------------------------------------------------------------
94      DO jk = 1, jpkm1
95         DO jj = 2, jpjm1
96            DO ji = fs_2, fs_jpim1
97               ze3t = 1. / fse3t(ji,jj,jk)
98               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
99            END DO
100         END DO
101      END DO
102
103      ! Find the last level of the water column
104      ! Compute fluxes due to sinking particles (slow)
105   
106
107      zgeolpoc = 0.e0         !     Initialization
108      ! Release of nutrients from the "simple" sediment
109      DO jj = 2, jpjm1
110         DO ji = fs_2, fs_jpim1
111            ikt = mbkt(ji,jj) 
112            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt) 
113            ! Deposition of organic matter in the sediment
114            zwork = vsed * trn(ji,jj,ikt,jpdet)
115            zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
116               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
117            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
118         END DO
119      END DO
120
121      DO jj = 2, jpjm1
122         DO ji = fs_2, fs_jpim1
123            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
124         END DO
125      END DO
126
127      CALL lbc_lnk( sedpocn, 'T', 1. )
128 
129      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
130      IF( lk_iomput ) THEN 
131         CALL iom_put( "SEDPOC" , sedpocn )
132      ELSE
133         IF( ln_diatrc )           trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:)
134      ENDIF
135
136     
137      ! Time filter and swap of arrays
138      ! ------------------------------
139      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
140        !                                             ! (only swap)
141        sedpocn(:,:) = zsedpoca(:,:)
142        !                                             
143      ELSE
144        !
145        DO jj = 1, jpj
146           DO ji = 1, jpi
147              zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
148              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
149              sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
150           END DO
151        END DO
152        !
153      ENDIF
154      !
155      IF( lrst_trc ) THEN
156         IF(lwp) WRITE(numout,*)
157         IF(lwp) WRITE(numout,*) 'p2z_exp : POC in sediment fields written in ocean restart file ',   &
158            &                    'at it= ', kt,' date= ', ndastp
159         IF(lwp) WRITE(numout,*) '~~~~'
160         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
161         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
162      ENDIF
163      !
164      IF( l_trdtrc ) THEN
165         ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:)
166         jl = jp_pcs0_trd + 16
167         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend
168         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends
169      ENDIF
170      !
171      CALL wrk_dealloc( jpi, jpj, zsedpoca)   ! temporary save of trends
172
173      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
174         WRITE(charout, FMT="('exp')")
175         CALL prt_ctl_trc_info(charout)
176         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
177      ENDIF
178      !
179      IF( nn_timing == 1 )  CALL timing_stop('p2z_exp')
180      !
181   END SUBROUTINE p2z_exp
182
183   SUBROUTINE p2z_exp_init
184      !!----------------------------------------------------------------------
185      !!                    ***  ROUTINE p4z_exp_init  ***
186      !! ** purpose :   specific initialisation for export
187      !!----------------------------------------------------------------------
188      INTEGER  ::   ji, jj, jk
189      REAL(wp) ::   zmaskt, zfluo, zfluu
190      REAL(wp), POINTER, DIMENSION(:,:  ) :: zrro
191      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdm0
192      !!---------------------------------------------------------------------
193
194      IF(lwp) THEN
195         WRITE(numout,*)
196         WRITE(numout,*) ' p2z_exp: LOBSTER export'
197         WRITE(numout,*) ' ~~~~~~~'
198         WRITE(numout,*) '  compute remineralisation-damping arrays for tracers'
199      ENDIF
200      !
201      ! Allocate temporary workspace
202      CALL wrk_alloc( jpi, jpj,      zrro )
203      CALL wrk_alloc( jpi, jpj, jpk, zdm0 )
204
205
206      ! Calculate vertical distribution of newly formed biogenic poc
207      ! in the water column in the case of max. possible bottom depth
208      ! ------------------------------------------------------------
209      zdm0 = 0._wp
210      zrro = 1._wp
211      DO jk = jpkb, jpkm1
212         DO jj = 1, jpj
213            DO ji = 1, jpi
214               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr
215               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr
216               IF( zfluo.GT.1. )   zfluo = 1._wp
217               zdm0(ji,jj,jk) = zfluo - zfluu
218               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
219               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
220            END DO
221         END DO
222      END DO
223      !
224      zdm0(:,:,jpk) = zrro(:,:)
225
226      ! Calculate vertical distribution of newly formed biogenic poc
227      ! in the water column with realistic topography (first "dry" layer
228      ! contains total fraction, which has passed to the upper layers)
229      ! ----------------------------------------------------------------------
230      dminl(:,:)   = 0._wp
231      dmin3(:,:,:) = zdm0
232      DO jk = 1, jpk
233         DO jj = 1, jpj
234            DO ji = 1, jpi
235               IF( tmask(ji,jj,jk) == 0._wp ) THEN
236                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
237                  dmin3(ji,jj,jk) = 0._wp
238               ENDIF
239            END DO
240         END DO
241      END DO
242
243      DO jj = 1, jpj
244         DO ji = 1, jpi
245            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
246         END DO
247      END DO
248
249      ! Coastal mask
250      cmask(:,:) = 0._wp
251      DO jj = 2, jpjm1
252         DO ji = fs_2, fs_jpim1
253            IF( tmask(ji,jj,1) /= 0. ) THEN
254               zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
255               IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
256            END IF
257         END DO
258      END DO
259      CALL lbc_lnk( cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
260      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) )
261      !
262      IF( ln_rsttr ) THEN
263         CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
264         CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
265      ELSE
266         sedpocb(:,:) = 0._wp
267         sedpocn(:,:) = 0._wp
268      ENDIF
269      !
270      CALL wrk_dealloc( jpi, jpj,      zrro )
271      CALL wrk_dealloc( jpi, jpj, jpk, zdm0 )
272      !
273   END SUBROUTINE p2z_exp_init
274
275   INTEGER FUNCTION p2z_exp_alloc()
276      !!----------------------------------------------------------------------
277      !!                     ***  ROUTINE p2z_exp_alloc  ***
278      !!----------------------------------------------------------------------
279      ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
280         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj),   STAT=p2z_exp_alloc )
281      IF( p2z_exp_alloc /= 0 ) CALL ctl_warn('p2z_exp_alloc : failed to allocate arrays.')
282      !
283   END FUNCTION p2z_exp_alloc
284
285#else
286   !!======================================================================
287   !!  Dummy module :                                   No PISCES bio-model
288   !!======================================================================
289CONTAINS
290   SUBROUTINE p2z_exp( kt )                   ! Empty routine
291      INTEGER, INTENT( in ) ::   kt
292      WRITE(*,*) 'p2z_exp: You should not have seen this print! error?', kt
293   END SUBROUTINE p2z_exp
294#endif 
295
296   !!======================================================================
297END MODULE  p2zexp
Note: See TracBrowser for help on using the repository browser.