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 trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

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