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/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/TOP/PISCES/P2Z/p2zexp.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496
  • Property svn:keywords set to Id
File size: 10.2 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          ! 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 "do_loop_substitute.h90"
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
44   !! $Id$
45   !! Software governed by the CeCILL license (see ./LICENSE)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE p2z_exp( kt, Kmm, Krhs )
50      !!---------------------------------------------------------------------
51      !!                     ***  ROUTINE p2z_exp  ***
52      !!
53      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
54      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
55      !!
56      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
57      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
58      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION.
59      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
60      !!              COLUMN BELOW THE SURFACE LAYER.
61      !!---------------------------------------------------------------------
62      !!
63      INTEGER, INTENT( in ) ::   kt             ! ocean time-step index     
64      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices
65      !!
66      INTEGER  ::   ji, jj, jk, jl, ikt
67      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
68      REAL(wp), DIMENSION(jpi,jpj)   ::  zsedpoca
69      CHARACTER (len=25) :: charout
70      !!---------------------------------------------------------------------
71      !
72      IF( ln_timing )   CALL timing_start('p2z_exp')
73      !
74      IF( kt == nittrc000 )   CALL p2z_exp_init( Kmm )
75
76      zsedpoca(:,:) = 0.
77
78
79      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
80      ! POC IN THE WATER COLUMN
81      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
82      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90
83      ! ----------------------------------------------------------------------
84      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
85         ze3t = 1. / e3t(ji,jj,jk,Kmm)
86         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
87      END_3D
88
89      ! Find the last level of the water column
90      ! Compute fluxes due to sinking particles (slow)
91   
92
93      zgeolpoc = 0.e0         !     Initialization
94      ! Release of nutrients from the "simple" sediment
95      DO_2D( 0, 0, 0, 0 )
96         ikt = mbkt(ji,jj) 
97         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 
98         ! Deposition of organic matter in the sediment
99         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm)
100         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
101            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rn_Dt
102         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
103      END_2D
104
105      DO_2D( 0, 0, 0, 0 )
106         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm)
107      END_2D
108
109#if defined key_mpi3
110      CALL lbc_lnk_nc_multi( 'p2zexp', sedpocn, 'T', 1.0_wp )
111#else
112      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1.0_wp )
113#endif
114 
115      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
116      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn )
117
118     
119      ! Time filter and swap of arrays
120      ! ------------------------------
121      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step
122        !                           ! (only swap)
123        sedpocn(:,:) = zsedpoca(:,:)
124        !                                             
125      ELSE
126        !
127        DO_2D( 1, 1, 1, 1 )
128           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
129           sedpocb(ji,jj) = sedpocn(ji,jj) + rn_atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
130           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
131        END_2D
132        !
133      ENDIF
134      !
135      IF( lrst_trc ) THEN
136         IF(lwp) WRITE(numout,*)
137         IF(lwp) WRITE(numout,*) 'p2z_exp : POC in sediment fields written in ocean restart file ',   &
138            &                    'at it= ', kt,' date= ', ndastp
139         IF(lwp) WRITE(numout,*) '~~~~'
140         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
141         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
142      ENDIF
143      !
144      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
145         WRITE(charout, FMT="('exp')")
146         CALL prt_ctl_info( charout, cdcomp = 'top' )
147         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
148      ENDIF
149      !
150      IF( ln_timing )  CALL timing_stop('p2z_exp')
151      !
152   END SUBROUTINE p2z_exp
153
154
155   SUBROUTINE p2z_exp_init( Kmm )
156      !!----------------------------------------------------------------------
157      !!                    ***  ROUTINE p4z_exp_init  ***
158      !! ** purpose :   specific initialisation for export
159      !!----------------------------------------------------------------------
160      INTEGER, INTENT(in)  ::  Kmm      ! time level index
161      INTEGER  ::   ji, jj, jk
162      REAL(wp) ::   zmaskt, zfluo, zfluu
163      REAL(wp), DIMENSION(jpi,jpj    ) :: zrro
164      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0
165      !!---------------------------------------------------------------------
166      !
167      IF(lwp) THEN
168         WRITE(numout,*)
169         WRITE(numout,*) ' p2z_exp: LOBSTER export'
170         WRITE(numout,*) ' ~~~~~~~'
171         WRITE(numout,*) '  compute remineralisation-damping arrays for tracers'
172      ENDIF
173      !
174
175      ! Calculate vertical distribution of newly formed biogenic poc
176      ! in the water column in the case of max. possible bottom depth
177      ! ------------------------------------------------------------
178      zdm0 = 0._wp
179      zrro = 1._wp
180      DO_3D( 1, 1, 1, 1, jpkb, jpkm1 )
181         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
182         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
183         IF( zfluo.GT.1. )   zfluo = 1._wp
184         zdm0(ji,jj,jk) = zfluo - zfluu
185         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
186         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
187      END_3D
188      !
189      zdm0(:,:,jpk) = zrro(:,:)
190
191      ! Calculate vertical distribution of newly formed biogenic poc
192      ! in the water column with realistic topography (first "dry" layer
193      ! contains total fraction, which has passed to the upper layers)
194      ! ----------------------------------------------------------------------
195      dminl(:,:)   = 0._wp
196      dmin3(:,:,:) = zdm0
197      DO_3D( 1, 1, 1, 1, 1, jpk )
198         IF( tmask(ji,jj,jk) == 0._wp ) THEN
199            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
200            dmin3(ji,jj,jk) = 0._wp
201         ENDIF
202      END_3D
203
204      DO_2D( 1, 1, 1, 1 )
205         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
206      END_2D
207
208      ! Coastal mask
209      cmask(:,:) = 0._wp
210      DO_2D( 0, 0, 0, 0 )
211         IF( tmask(ji,jj,1) /= 0. ) THEN
212            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
213            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
214         END IF
215      END_2D
216#if defined key_mpi3
217      CALL lbc_lnk_nc_multi( 'p2zexp', cmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged)
218#else
219      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1.0_wp )      ! lateral boundary conditions on cmask   (sign unchanged)
220#endif
221      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) )
222      !
223      IF( ln_rsttr ) THEN
224         CALL iom_get( numrtr, jpdom_auto, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
225         CALL iom_get( numrtr, jpdom_auto, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
226      ELSE
227         sedpocb(:,:) = 0._wp
228         sedpocn(:,:) = 0._wp
229      ENDIF
230      !
231   END SUBROUTINE p2z_exp_init
232
233   INTEGER FUNCTION p2z_exp_alloc()
234      !!----------------------------------------------------------------------
235      !!                     ***  ROUTINE p2z_exp_alloc  ***
236      !!----------------------------------------------------------------------
237      ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
238         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj),   STAT=p2z_exp_alloc )
239      IF( p2z_exp_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p2z_exp_alloc : failed to allocate arrays.' )
240      !
241   END FUNCTION p2z_exp_alloc
242
243   !!======================================================================
244END MODULE p2zexp
Note: See TracBrowser for help on using the repository browser.