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/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmort.F90 @ 11960

Last change on this file since 11960 was 11960, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. Merge in changes from 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. (svn merge -r 11614:11954). Resolved tree conflicts and one actual conflict. Sette tested(these changes alter the ext/AGRIF reference; remember to update). See ticket #2341
  • Property svn:keywords set to Id
File size: 11.9 KB
RevLine 
[3443]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   !!----------------------------------------------------------------------
[9169]9   !!   p4z_mort       : Compute the mortality terms for phytoplankton
10   !!   p4z_mort_init  : Initialize the mortality params for phytoplankton
[3443]11   !!----------------------------------------------------------------------
[9169]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
[10227]16   USE p4zlim          ! Phytoplankton limitation terms
[9169]17   USE prtctl_trc      ! print control for debugging
[3443]18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   p4z_mort   
23   PUBLIC   p4z_mort_init   
24
[9169]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   !:
[3443]30
31   !!----------------------------------------------------------------------
[10067]32   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[7753]33   !! $Id$
[10068]34   !! Software governed by the CeCILL license (see ./LICENSE)
[3443]35   !!----------------------------------------------------------------------
36CONTAINS
37
[11949]38   SUBROUTINE p4z_mort( kt, Kbb, Krhs )
[3443]39      !!---------------------------------------------------------------------
40      !!                     ***  ROUTINE p4z_mort  ***
41      !!
42      !! ** Purpose :   Calls the different subroutine to initialize and compute
43      !!                the different phytoplankton mortality terms
44      !!
45      !! ** Method  : - ???
46      !!---------------------------------------------------------------------
47      INTEGER, INTENT(in) ::   kt ! ocean time step
[11949]48      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[3443]49      !!---------------------------------------------------------------------
[9169]50      !
[11949]51      CALL p4z_nano( Kbb, Krhs )            ! nanophytoplankton
[9169]52      !
[11949]53      CALL p4z_diat( Kbb, Krhs )            ! diatoms
[9169]54      !
[3443]55   END SUBROUTINE p4z_mort
56
57
[11949]58   SUBROUTINE p4z_nano( Kbb, Krhs )
[3443]59      !!---------------------------------------------------------------------
60      !!                     ***  ROUTINE p4z_nano  ***
61      !!
62      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
63      !!
64      !! ** Method  : - ???
65      !!---------------------------------------------------------------------
[11949]66      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[9169]67      INTEGER  ::   ji, jj, jk
68      REAL(wp) ::   zsizerat, zcompaph
69      REAL(wp) ::   zfactfe, zfactch, zprcaca, zfracal
70      REAL(wp) ::   ztortp , zrespp , zmortp 
71      CHARACTER (len=25) ::   charout
[3443]72      !!---------------------------------------------------------------------
73      !
[9124]74      IF( ln_timing )   CALL timing_start('p4z_nano')
[3443]75      !
[9169]76      prodcal(:,:,:) = 0._wp   ! calcite production variable set to zero
[3443]77      DO jk = 1, jpkm1
78         DO jj = 1, jpj
79            DO ji = 1, jpi
[11949]80               zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-8 ), 0.e0 )
[4529]81               !     When highly limited by macronutrients, very small cells
82               !     dominate the community. As a consequence, aggregation
83               !     due to turbulence is negligible. Mortality is also set
84               !     to 0
[11949]85               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * tr(ji,jj,jk,jpphy,Kbb)
[3443]86               !     Squared mortality of Phyto similar to a sedimentation term during
87               !     blooms (Doney et al. 1996)
[7646]88               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
[3443]89
90               !     Phytoplankton mortality. This mortality loss is slightly
91               !     increased when nutrients are limiting phytoplankton growth
92               !     as observed for instance in case of iron limitation.
[11949]93               ztortp = mprat * xstep * zcompaph / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) ) * zsizerat
[3443]94
95               zmortp = zrespp + ztortp
96
97               !   Update the arrays TRA which contains the biological sources and sinks
98
[11949]99               zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
100               zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
101               tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp
102               tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch
103               tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe
[3443]104               zprcaca = xfracal(ji,jj,jk) * zmortp
105               !
106               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
107               !
108               zfracal = 0.5 * xfracal(ji,jj,jk)
[11949]109               tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
110               tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
111               tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
112               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zfracal * zmortp
113               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ( 1. - zfracal ) * zmortp
[7646]114               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
115               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
[11949]116               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ( 1. - zfracal ) * zmortp * zfactfe
117               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zfracal * zmortp * zfactfe
[3443]118            END DO
119         END DO
120      END DO
121      !
122       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
123         WRITE(charout, FMT="('nano')")
124         CALL prt_ctl_trc_info(charout)
[11949]125         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
[3443]126       ENDIF
127      !
[9124]128      IF( ln_timing )   CALL timing_stop('p4z_nano')
[3443]129      !
130   END SUBROUTINE p4z_nano
131
[9124]132
[11949]133   SUBROUTINE p4z_diat( Kbb, Krhs )
[3443]134      !!---------------------------------------------------------------------
135      !!                     ***  ROUTINE p4z_diat  ***
136      !!
137      !! ** Purpose :   Compute the mortality terms for diatoms
138      !!
139      !! ** Method  : - ???
140      !!---------------------------------------------------------------------
[11949]141      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[9169]142      INTEGER  ::   ji, jj, jk
143      REAL(wp) ::   zfactfe,zfactsi,zfactch, zcompadi
144      REAL(wp) ::   zrespp2, ztortp2, zmortp2
145      REAL(wp) ::   zlim2, zlim1
146      CHARACTER (len=25) ::   charout
[3443]147      !!---------------------------------------------------------------------
148      !
[9124]149      IF( ln_timing )   CALL timing_start('p4z_diat')
[3443]150      !
151      !    Aggregation term for diatoms is increased in case of nutrient
152      !    stress as observed in reality. The stressed cells become more
153      !    sticky and coagulate to sink quickly out of the euphotic zone
154      !     ------------------------------------------------------------
155
156      DO jk = 1, jpkm1
157         DO jj = 1, jpj
158            DO ji = 1, jpi
159
[11949]160               zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1e-9), 0. )
[3443]161
162               !    Aggregation term for diatoms is increased in case of nutrient
163               !    stress as observed in reality. The stressed cells become more
164               !    sticky and coagulate to sink quickly out of the euphotic zone
165               !     ------------------------------------------------------------
166               !  Phytoplankton respiration
167               !     ------------------------
[3446]168               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
169               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
[11949]170               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
[3443]171
172               !     Phytoplankton mortality.
173               !     ------------------------
[11949]174               ztortp2 = mprat2 * xstep * tr(ji,jj,jk,jpdia,Kbb)  / ( xkmort + tr(ji,jj,jk,jpdia,Kbb) ) * zcompadi 
[3443]175
176               zmortp2 = zrespp2 + ztortp2
177
[11949]178               !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
[3443]179               !   ---------------------------------------------------------------------
[11949]180               zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
181               zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
182               zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
183               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
184               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
185               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
186               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
187               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
188               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 + 0.5 * ztortp2
189               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + 0.5 * ztortp2
[7646]190               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
191               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
[11949]192               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + 0.5 * ztortp2 * zfactfe
193               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
[3443]194            END DO
195         END DO
196      END DO
197      !
[9169]198      IF(ln_ctl) THEN      ! print mean trends (used for debugging)
[3443]199         WRITE(charout, FMT="('diat')")
200         CALL prt_ctl_trc_info(charout)
[11949]201         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
[3443]202      ENDIF
203      !
[9124]204      IF( ln_timing )   CALL timing_stop('p4z_diat')
[3443]205      !
206   END SUBROUTINE p4z_diat
207
[9124]208
[3443]209   SUBROUTINE p4z_mort_init
210      !!----------------------------------------------------------------------
211      !!                  ***  ROUTINE p4z_mort_init  ***
212      !!
213      !! ** Purpose :   Initialization of phytoplankton parameters
214      !!
215      !! ** Method  :   Read the nampismort namelist and check the parameters
[9169]216      !!              called at the first timestep
[3443]217      !!
218      !! ** input   :   Namelist nampismort
219      !!
220      !!----------------------------------------------------------------------
[9124]221      INTEGER ::   ios   ! Local integer
222      !
[7646]223      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2
[9124]224      !!----------------------------------------------------------------------
225      !
[9169]226      IF(lwp) THEN
227         WRITE(numout,*) 
228         WRITE(numout,*) 'p4z_mort_init : Initialization of phytoplankton mortality parameters'
229         WRITE(numout,*) '~~~~~~~~~~~~~'
230      ENDIF
231      !
[7646]232      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901)
[11536]233901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmort in reference namelist' )
[7646]234      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 )
[11536]235902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmort in configuration namelist' )
[9169]236      IF(lwm) WRITE( numonp, namp4zmort )
[9124]237      !
[3443]238      IF(lwp) THEN                         ! control print
[9169]239         WRITE(numout,*) '   Namelist : namp4zmort'
240         WRITE(numout,*) '      quadratic mortality of phytoplankton        wchl   =', wchl
241         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchld  =', wchld
242         WRITE(numout,*) '      maximum quadratic mortality of diatoms      wchldm =', wchldm
243         WRITE(numout,*) '      phytoplankton mortality rate                mprat  =', mprat
244         WRITE(numout,*) '      Diatoms mortality rate                      mprat2 =', mprat2
[3443]245      ENDIF
[9124]246      !
[3443]247   END SUBROUTINE p4z_mort_init
248
249   !!======================================================================
[5656]250END MODULE p4zmort
Note: See TracBrowser for help on using the repository browser.