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/KERNEL-03_Storkey_Coward_RK3_stage2/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2020/KERNEL-03_Storkey_Coward_RK3_stage2/src/TOP/PISCES/P2Z/p2zexp.F90 @ 12397

Last change on this file since 12397 was 12397, checked in by davestorkey, 4 years ago

2020/KERNEL-03_Storkey_Coward_RK3_stage2 : Consolidation of code to
handle initial Euler timestep in the context of leapfrog
timestepping. This version passes all SETTE tests but fails to bit
compare with the control for several tests (ORCA2_ICE_PISCES, AMM12,
ISOMIP, AGRIF_DEMO, SPITZ12).
  • Property svn:keywords set to Id
File size: 9.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   !!   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 "do_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
43   !! $Id$
44   !! Software governed by the CeCILL license (see ./LICENSE)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE p2z_exp( kt, Kmm, Krhs )
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      INTEGER, INTENT( in ) ::   Kmm, Krhs      ! time level indices
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( Kmm )
74
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_3D_00_00( 1, jpkm1 )
84         ze3t = 1. / e3t(ji,jj,jk,Kmm)
85         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj)
86      END_3D
87
88      ! Find the last level of the water column
89      ! Compute fluxes due to sinking particles (slow)
90   
91
92      zgeolpoc = 0.e0         !     Initialization
93      ! Release of nutrients from the "simple" sediment
94      DO_2D_00_00
95         ikt = mbkt(ji,jj) 
96         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm) 
97         ! Deposition of organic matter in the sediment
98         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm)
99         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   &
100            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
101         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
102      END_2D
103
104      DO_2D_00_00
105         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm)
106      END_2D
107
108      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. )
109 
110      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
111      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn )
112
113     
114      ! Time filter and swap of arrays
115      ! ------------------------------
116      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step
117        !                           ! (only swap)
118        sedpocn(:,:) = zsedpoca(:,:)
119        !                                             
120      ELSE
121        !
122        DO_2D_11_11
123           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
124           sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
125           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
126        END_2D
127        !
128      ENDIF
129      !
130      IF( lrst_trc ) THEN
131         IF(lwp) WRITE(numout,*)
132         IF(lwp) WRITE(numout,*) 'p2z_exp : POC in sediment fields written in ocean restart file ',   &
133            &                    'at it= ', kt,' date= ', ndastp
134         IF(lwp) WRITE(numout,*) '~~~~'
135         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
136         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
137      ENDIF
138      !
139      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
140         WRITE(charout, FMT="('exp')")
141         CALL prt_ctl_trc_info(charout)
142         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
143      ENDIF
144      !
145      IF( ln_timing )  CALL timing_stop('p2z_exp')
146      !
147   END SUBROUTINE p2z_exp
148
149
150   SUBROUTINE p2z_exp_init( Kmm )
151      !!----------------------------------------------------------------------
152      !!                    ***  ROUTINE p4z_exp_init  ***
153      !! ** purpose :   specific initialisation for export
154      !!----------------------------------------------------------------------
155      INTEGER, INTENT(in)  ::  Kmm      ! time level index
156      INTEGER  ::   ji, jj, jk
157      REAL(wp) ::   zmaskt, zfluo, zfluu
158      REAL(wp), DIMENSION(jpi,jpj    ) :: zrro
159      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0
160      !!---------------------------------------------------------------------
161      !
162      IF(lwp) THEN
163         WRITE(numout,*)
164         WRITE(numout,*) ' p2z_exp: LOBSTER export'
165         WRITE(numout,*) ' ~~~~~~~'
166         WRITE(numout,*) '  compute remineralisation-damping arrays for tracers'
167      ENDIF
168      !
169
170      ! Calculate vertical distribution of newly formed biogenic poc
171      ! in the water column in the case of max. possible bottom depth
172      ! ------------------------------------------------------------
173      zdm0 = 0._wp
174      zrro = 1._wp
175      DO_3D_11_11( jpkb, jpkm1 )
176         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
177         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr
178         IF( zfluo.GT.1. )   zfluo = 1._wp
179         zdm0(ji,jj,jk) = zfluo - zfluu
180         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp
181         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk)
182      END_3D
183      !
184      zdm0(:,:,jpk) = zrro(:,:)
185
186      ! Calculate vertical distribution of newly formed biogenic poc
187      ! in the water column with realistic topography (first "dry" layer
188      ! contains total fraction, which has passed to the upper layers)
189      ! ----------------------------------------------------------------------
190      dminl(:,:)   = 0._wp
191      dmin3(:,:,:) = zdm0
192      DO_3D_11_11( 1, jpk )
193         IF( tmask(ji,jj,jk) == 0._wp ) THEN
194            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk)
195            dmin3(ji,jj,jk) = 0._wp
196         ENDIF
197      END_3D
198
199      DO_2D_11_11
200         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp
201      END_2D
202
203      ! Coastal mask
204      cmask(:,:) = 0._wp
205      DO_2D_00_00
206         IF( tmask(ji,jj,1) /= 0. ) THEN
207            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1) 
208            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp
209         END IF
210      END_2D
211      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
212      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) )
213      !
214      IF( ln_rsttr ) THEN
215         CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
216         CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
217      ELSE
218         sedpocb(:,:) = 0._wp
219         sedpocn(:,:) = 0._wp
220      ENDIF
221      !
222   END SUBROUTINE p2z_exp_init
223
224   INTEGER FUNCTION p2z_exp_alloc()
225      !!----------------------------------------------------------------------
226      !!                     ***  ROUTINE p2z_exp_alloc  ***
227      !!----------------------------------------------------------------------
228      ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), &
229         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj),   STAT=p2z_exp_alloc )
230      IF( p2z_exp_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p2z_exp_alloc : failed to allocate arrays.' )
231      !
232   END FUNCTION p2z_exp_alloc
233
234   !!======================================================================
235END MODULE p2zexp
Note: See TracBrowser for help on using the repository browser.