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.
p4zmort.F90 in NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/PISCES/P4Z/p4zmort.F90 @ 14219

Last change on this file since 14219 was 14219, checked in by mcastril, 4 years ago

Add Mixed Precision support by Oriol Tintó
  • Property svn:keywords set to Id
File size: 11.5 KB
Line 
1MODULE p4zmort
2   !!======================================================================
3   !!                         ***  MODULE p4zmort  ***
4   !! TOP :   PISCES Compute the mortality terms for phytoplankton
5   !!======================================================================
6   !! History :   1.0  !  2002     (O. Aumont)  Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!----------------------------------------------------------------------
9   !!   p4z_mort       : Compute the mortality terms for phytoplankton
10   !!   p4z_mort_init  : Initialize the mortality params for phytoplankton
11   !!----------------------------------------------------------------------
12   USE oce_trc         ! shared variables between ocean and passive tracers
13   USE trc             ! passive tracers common variables
14   USE sms_pisces      ! PISCES Source Minus Sink variables
15   USE p4zprod         ! Primary productivity
16   USE p4zlim          ! Phytoplankton limitation terms
17   USE prtctl          ! print control for debugging
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   p4z_mort   
23   PUBLIC   p4z_mort_init   
24
25   REAL(wp), PUBLIC ::   wchl     !:
26   REAL(wp), PUBLIC ::   wchld    !:
27   REAL(wp), PUBLIC ::   wchldm   !:
28   REAL(wp), PUBLIC ::   mprat    !:
29   REAL(wp), PUBLIC ::   mprat2   !:
30
31   !! * Substitutions
32#  include "do_loop_substitute.h90"
33#  include "single_precision_substitute.h90"
34   !!----------------------------------------------------------------------
35   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
36   !! $Id$
37   !! Software governed by the CeCILL license (see ./LICENSE)
38   !!----------------------------------------------------------------------
39CONTAINS
40
41   SUBROUTINE p4z_mort( kt, Kbb, Krhs )
42      !!---------------------------------------------------------------------
43      !!                     ***  ROUTINE p4z_mort  ***
44      !!
45      !! ** Purpose :   Calls the different subroutine to initialize and compute
46      !!                the different phytoplankton mortality terms
47      !!
48      !! ** Method  : - ???
49      !!---------------------------------------------------------------------
50      INTEGER, INTENT(in) ::   kt ! ocean time step
51      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
52      !!---------------------------------------------------------------------
53      !
54      CALL p4z_nano( Kbb, Krhs )            ! nanophytoplankton
55      !
56      CALL p4z_diat( Kbb, Krhs )            ! diatoms
57      !
58   END SUBROUTINE p4z_mort
59
60
61   SUBROUTINE p4z_nano( Kbb, Krhs )
62      !!---------------------------------------------------------------------
63      !!                     ***  ROUTINE p4z_nano  ***
64      !!
65      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
66      !!
67      !! ** Method  : - ???
68      !!---------------------------------------------------------------------
69      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
70      INTEGER  ::   ji, jj, jk
71      REAL(wp) ::   zsizerat, zcompaph
72      REAL(wp) ::   zfactfe, zfactch, zprcaca, zfracal
73      REAL(wp) ::   ztortp , zrespp , zmortp 
74      CHARACTER (len=25) ::   charout
75      !!---------------------------------------------------------------------
76      !
77      IF( ln_timing )   CALL timing_start('p4z_nano')
78      !
79      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero
80      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
81         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 )
82         !     When highly limited by macronutrients, very small cells
83         !     dominate the community. As a consequence, aggregation
84         !     due to turbulence is negligible. Mortality is also set
85         !     to 0
86         zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb)
87         !     Squared mortality of Phyto similar to a sedimentation term during
88         !     blooms (Doney et al. 1996)
89         zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
90
91         !     Phytoplankton mortality. This mortality loss is slightly
92         !     increased when nutrients are limiting phytoplankton growth
93         !     as observed for instance in case of iron limitation.
94         ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat
95
96         zmortp = zrespp + ztortp
97
98         !   Update the arrays TRA which contains the biological sources and sinks
99
100         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
101         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
102         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp
103         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch
104         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe
105         zprcaca = xfracal(ji,jj,jk) * zmortp
106         !
107         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
108         !
109         zfracal = 0.5 * xfracal(ji,jj,jk)
110         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
111         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
112         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
113         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp
114         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp
115         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
116         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
117         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe
118         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe
119      END_3D
120      !
121       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
122         WRITE(charout, FMT="('nano')")
123         CALL prt_ctl_info( charout, cdcomp = 'top' )
124         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm)
125       ENDIF
126      !
127      IF( ln_timing )   CALL timing_stop('p4z_nano')
128      !
129   END SUBROUTINE p4z_nano
130
131
132   SUBROUTINE p4z_diat( Kbb, Krhs )
133      !!---------------------------------------------------------------------
134      !!                     ***  ROUTINE p4z_diat  ***
135      !!
136      !! ** Purpose :   Compute the mortality terms for diatoms
137      !!
138      !! ** Method  : - ???
139      !!---------------------------------------------------------------------
140      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
141      INTEGER  ::   ji, jj, jk
142      REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi
143      REAL(wp) ::   zrespp2, ztortp2, zmortp2
144      REAL(wp) ::   zlim2, zlim1
145      CHARACTER (len=25) ::   charout
146      !!---------------------------------------------------------------------
147      !
148      IF( ln_timing )   CALL timing_start('p4z_diat')
149      !
150      !    Aggregation term for diatoms is increased in case of nutrient
151      !    stress as observed in reality. The stressed cells become more
152      !    sticky and coagulate to sink quickly out of the euphotic zone
153      !     ------------------------------------------------------------
154
155      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
156
157         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. )
158
159         !    Aggregation term for diatoms is increased in case of nutrient
160         !    stress as observed in reality. The stressed cells become more
161         !    sticky and coagulate to sink quickly out of the euphotic zone
162         !     ------------------------------------------------------------
163         !  Phytoplankton respiration
164         !     ------------------------
165         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
166         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
167         zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
168
169         !     Phytoplankton mortality.
170         !     ------------------------
171         ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 
172
173         zmortp2 = zrespp2 + ztortp2
174
175         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
176         !   ---------------------------------------------------------------------
177         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
178         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
179         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
180         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
181         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
182         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
183         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
184         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
185         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2
186         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2
187         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
188         prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
189         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe
190         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
191      END_3D
192      !
193      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
194         WRITE(charout, FMT="('diat')")
195         CALL prt_ctl_info( charout, cdcomp = 'top' )
196         CALL prt_ctl(tab4d_1=CASTWP(tr(:,:,:,:,Krhs)), mask1=tmask, clinfo=ctrcnm)
197      ENDIF
198      !
199      IF( ln_timing )   CALL timing_stop('p4z_diat')
200      !
201   END SUBROUTINE p4z_diat
202
203
204   SUBROUTINE p4z_mort_init
205      !!----------------------------------------------------------------------
206      !!                  ***  ROUTINE p4z_mort_init  ***
207      !!
208      !! ** Purpose :   Initialization of phytoplankton parameters
209      !!
210      !! ** Method  :   Read the nampismort namelist and check the parameters
211      !!              called at the first timestep
212      !!
213      !! ** input   :   Namelist nampismort
214      !!
215      !!----------------------------------------------------------------------
216      INTEGER ::   ios   ! Local integer
217      !
218      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2
219      !!----------------------------------------------------------------------
220      !
221      IF(lwp) THEN
222         WRITE(numout,*) 
223         WRITE(numout,*) 'p4z_mort_init : Initialization of phytoplankton mortality parameters'
224         WRITE(numout,*) '~~~~~~~~~~~~~'
225      ENDIF
226      !
227      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901)
228901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist' )
229      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 )
230902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' )
231      IF(lwm) WRITE( numonp, namp4zmort )
232      !
233      IF(lwp) THEN                         ! control print
234         WRITE(numout,*) '   Namelist : namp4zmort'
235         WRITE(numout,*) '      quadratic mortality of phytoplankton        wchl   =', wchl
236         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchld  =', wchld
237         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchldm =', wchldm
238         WRITE(numout,*) '      phytoplankton mortality rate                mprat  =', mprat
239         WRITE(numout,*) '      Diatoms mortality rate                      mprat2 =', mprat2
240      ENDIF
241      !
242   END SUBROUTINE p4z_mort_init
243
244   !!======================================================================
245END MODULE p4zmort
Note: See TracBrowser for help on using the repository browser.