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

source: NEMO/branches/UKMO/r8395_obs_oper_update/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90 @ 11350

Last change on this file since 11350 was 11350, checked in by jcastill, 5 years ago

Clear svn keywords

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