Changeset 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES

Timestamp:

2016-11-30T17:56:53+01:00 (7 years ago)

Author:

timgraham

Message:

Merge dev_INGV_METO_merge_2016 into branch

Location:

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES

Files:

• P2Z/p2zbio.F90 (modified) (10 diffs)
• P2Z/p2zexp.F90 (modified) (6 diffs)
• P2Z/p2zopt.F90 (modified) (2 diffs)
• P2Z/p2zsed.F90 (modified) (5 diffs)
• P2Z/p2zsms.F90 (modified) (2 diffs)
• P4Z/p4zagg.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90)
• P4Z/p4zbio.F90 (modified) (4 diffs)
• P4Z/p4zche.F90 (modified) (19 diffs)
• P4Z/p4zfechem.F90 (modified) (20 diffs)
• P4Z/p4zflx.F90 (modified) (18 diffs)
• P4Z/p4zint.F90 (modified) (3 diffs)
• P4Z/p4zligand.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90)
• P4Z/p4zlim.F90 (modified) (7 diffs)
• P4Z/p4zlys.F90 (modified) (9 diffs)
• P4Z/p4zmeso.F90 (modified) (15 diffs)
• P4Z/p4zmicro.F90 (modified) (14 diffs)
• P4Z/p4zmort.F90 (modified) (12 diffs)
• P4Z/p4zopt.F90 (modified) (13 diffs)
• P4Z/p4zpoc.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90)
• P4Z/p4zprod.F90 (modified) (26 diffs)
• P4Z/p4zrem.F90 (modified) (13 diffs)
• P4Z/p4zsbc.F90 (modified) (11 diffs)
• P4Z/p4zsed.F90 (modified) (20 diffs)
• P4Z/p4zsink.F90 (modified) (14 diffs)
• P4Z/p4zsms.F90 (modified) (17 diffs)
• P4Z/p5zlim.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zlim.F90)
• P4Z/p5zmeso.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmeso.F90)
• P4Z/p5zmicro.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmicro.F90)
• P4Z/p5zmort.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90)
• P4Z/p5zprod.F90 (copied) (copied from branches/2016/dev_INGV_METO_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zprod.F90)
• SED/par_sed.F90 (modified) (1 diff)
• SED/sed.F90 (modified) (1 diff)
• SED/seddta.F90 (modified) (9 diffs)
• SED/sedmodel.F90 (modified) (2 diffs)
• par_pisces.F90 (modified) (1 diff)
• sms_pisces.F90 (modified) (9 diffs)
• trcice_pisces.F90 (modified) (15 diffs)
• trcini_pisces.F90 (modified) (16 diffs)
• trcnam_pisces.F90 (modified) (3 diffs)
• trcsms_pisces.F90 (modified) (3 diffs)
• trcwri_pisces.F90 (modified) (2 diffs)

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

@@ -8 +8 @@
    !!              -   !  2001-03  (M. Levy)  LNO3 + dia2d 
    !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
-   !!----------------------------------------------------------------------
-#if defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces_reduced'                                     LOBSTER bio-model
    !!----------------------------------------------------------------------
    !!   p2z_bio        :  
@@ -86 +82 @@
       !!                                  source      sink
       !!        
-      !!              IF 'key_diabio' defined , the biogeochemical trends
-      !!              for passive tracers are saved for futher diagnostics.
       !!---------------------------------------------------------------------
       !!
@@ -109 +103 @@
       IF( nn_timing == 1 )  CALL timing_start('p2z_bio')
       !
-      IF( ln_diatrc .OR. lk_iomput ) THEN
+      IF( lk_iomput ) THEN
          CALL wrk_alloc( jpi, jpj,     17, zw2d )
          CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d )
@@ -121 +115 @@
 
       xksi(:,:) = 0.e0        ! zooplakton closure ( fbod)
-      IF( ln_diatrc .OR. lk_iomput ) THEN
+      IF( lk_iomput ) THEN
          zw2d  (:,:,:) = 0.e0
          zw3d(:,:,:,:) = 0.e0
@@ -218 +212 @@
                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
 
-
-               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
-                  trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy
-                  trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy
-                  trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4
-                  trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom
-                  trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo
-                  trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet
-                  trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo
-                  !  trend number 8 in p2zsed
-                  trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet
-                  trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod
-                  trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom
-                  trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3
-                  trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom
-                  !  trend number 17 in p2zexp
-                ENDIF
-                IF( ln_diatrc .OR. lk_iomput ) THEN
+                IF( lk_iomput ) THEN
                   ! convert fluxes in per day
                   ze3t = e3t_n(ji,jj,jk) * 86400._wp
@@ -340 +314 @@
                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
                !
-               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
-                  trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy
-                  trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy
-                  trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4
-                  trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom
-                  trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo
-                  trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet
-                  trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo
-                  !  trend number 8 in p2zsed
-                  trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet
-                  trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod
-                  trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom
-                  trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3
-                  trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4
-                  trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom
-                  !  trend number 17 in p2zexp 
-                ENDIF
-                IF( ln_diatrc .OR. lk_iomput ) THEN
+                IF( lk_iomput ) THEN
                   ! convert fluxes in per day
                   ze3t = e3t_n(ji,jj,jk) * 86400._wp
@@ -389 +344 @@
       END DO
 
-      IF( ln_diatrc .OR. lk_iomput ) THEN
+      IF( lk_iomput ) THEN
          DO jl = 1, 17 
             CALL lbc_lnk( zw2d(:,:,jl),'T', 1. )
@@ -420 +375 @@
         CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) )
          !
-       ELSE
-          IF( ln_diatrc ) THEN
-            !
-            trc2d(:,:,jp_pcs0_2d    ) = zw2d(:,:,1) 
-            trc2d(:,:,jp_pcs0_2d + 1) = zw2d(:,:,2) 
-            trc2d(:,:,jp_pcs0_2d + 2) = zw2d(:,:,3) 
-            trc2d(:,:,jp_pcs0_2d + 3) = zw2d(:,:,4) 
-            trc2d(:,:,jp_pcs0_2d + 4) = zw2d(:,:,5) 
-            trc2d(:,:,jp_pcs0_2d + 5) = zw2d(:,:,6) 
-            trc2d(:,:,jp_pcs0_2d + 6) = zw2d(:,:,7) 
-                     ! trend number 8 is in p2zsed.F
-            trc2d(:,:,jp_pcs0_2d +  8) = zw2d(:,:,8) 
-            trc2d(:,:,jp_pcs0_2d +  9) = zw2d(:,:,9) 
-            trc2d(:,:,jp_pcs0_2d + 10) = zw2d(:,:,10) 
-            trc2d(:,:,jp_pcs0_2d + 11) = zw2d(:,:,11) 
-            trc2d(:,:,jp_pcs0_2d + 12) = zw2d(:,:,12) 
-            trc2d(:,:,jp_pcs0_2d + 13) = zw2d(:,:,13) 
-            trc2d(:,:,jp_pcs0_2d + 14) = zw2d(:,:,14) 
-            trc2d(:,:,jp_pcs0_2d + 15) = zw2d(:,:,15) 
-            trc2d(:,:,jp_pcs0_2d + 16) = zw2d(:,:,16) 
-            trc2d(:,:,jp_pcs0_2d + 17) = zw2d(:,:,17) 
-            ! trend number 19 is in p2zexp.F
-            trc3d(:,:,:,jp_pcs0_3d    ) = zw3d(:,:,:,1) 
-            trc3d(:,:,:,jp_pcs0_3d + 1) = zw3d(:,:,:,2) 
-            trc3d(:,:,:,jp_pcs0_3d + 2) = zw3d(:,:,:,3) 
-         ENDIF
-        !
-      ENDIF
-
-      IF( ln_diabio .AND. .NOT. lk_iomput )  THEN
-         DO jl = jp_pcs0_trd, jp_pcs1_trd
-            CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. )
-         END DO 
-      ENDIF
-      !
-      IF( l_trdtrc ) THEN
-         DO jl = jp_pcs0_trd, jp_pcs1_trd
-            CALL trd_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend
-         END DO
       ENDIF
 
@@ -467 +383 @@
       ENDIF
       !
-      IF( ln_diatrc .OR. lk_iomput ) THEN
+      IF( lk_iomput ) THEN
          CALL wrk_dealloc( jpi, jpj,     17, zw2d )
          CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d )
@@ -586 +502 @@
    END SUBROUTINE p2z_bio_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p2z_bio( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p2z_bio: You should not have seen this print! error?', kt
-   END SUBROUTINE p2z_bio
-#endif 
-
    !!======================================================================
 END MODULE p2zbio

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

@@ -10 +10 @@
    !!             3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER
    !!----------------------------------------------------------------------
-#if defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces_reduced'                                     LOBSTER bio-model
-   !!----------------------------------------------------------------------
    !!   p2z_exp        :  Compute loss of organic matter in the sediments
    !!----------------------------------------------------------------------
@@ -68 +64 @@
       INTEGER  ::   ji, jj, jk, jl, ikt
       REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrbio
       REAL(wp), POINTER, DIMENSION(:,:)   ::  zsedpoca
       CHARACTER (len=25) :: charout
@@ -80 +75 @@
       zsedpoca(:,:) = 0.
 
-      IF( l_trdtrc )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends
-         ztrbio(:,:,:) = tra(:,:,:,jpno3)
-      ENDIF
 
       ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
@@ -126 +117 @@
  
       ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
-      IF( lk_iomput ) THEN  
-         CALL iom_put( "SEDPOC" , sedpocn )
-      ELSE
-         IF( ln_diatrc )           trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:)
-      ENDIF
+      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn )
 
       
@@ -160 +147 @@
       ENDIF
       !
-      IF( l_trdtrc ) THEN
-         ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:)
-         jl = jp_pcs0_trd + 16
-         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends
-      ENDIF
-      !
       CALL wrk_dealloc( jpi, jpj, zsedpoca)   ! temporary save of trends
 
@@ -281 +261 @@
    END FUNCTION p2z_exp_alloc
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p2z_exp( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p2z_exp: You should not have seen this print! error?', kt
-   END SUBROUTINE p2z_exp
-#endif 
-
    !!======================================================================
 END MODULE  p2zexp

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

@@ -10 +10 @@
    !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90
    !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style
-   !!----------------------------------------------------------------------
-#if defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces_reduced'                                     LOBSTER bio-model
    !!----------------------------------------------------------------------
    !!   p2z_opt        :   Compute the light availability in the water column
@@ -208 +204 @@
    END SUBROUTINE p2z_opt_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p2z_opt( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt
-   END SUBROUTINE p2z_opt
-#endif 
-
    !!======================================================================
 END MODULE  p2zopt

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

@@ -7 +7 @@
    !!              -   !  2000-12 (E. Kestenare)  clean up
    !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications
-   !!----------------------------------------------------------------------
-#if defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces_reduced'                                     LOBSTER bio-model
    !!----------------------------------------------------------------------
    !!   p2z_sed        :  Compute loss of organic matter in the sediments
@@ -66 +62 @@
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra
       !!---------------------------------------------------------------------
       !
@@ -79 +75 @@
       ! Allocate temporary workspace
       CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
-      IF( l_trdtrc ) THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
-         ztrbio(:,:,:) = tra(:,:,:,jpdet)
-      ENDIF
 
       ! sedimentation of detritus  : upstream scheme
@@ -116 +108 @@
             CALL wrk_dealloc( jpi, jpj, zw2d )
          ENDIF
-      ELSE
-         IF( ln_diatrc ) THEN 
-            CALL wrk_alloc( jpi, jpj, zw2d )
-            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
-            DO jk = 2, jpkm1
-               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
-            END DO
-            trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
-            CALL wrk_dealloc( jpi, jpj, zw2d )
-         ENDIF
       ENDIF
       !
-      IF( ln_diabio .AND. .NOT. lk_iomput )  trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)
       CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
       !
-      IF( l_trdtrc ) THEN
-         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
-         jl = jp_pcs0_trd + 7
-         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
-      ENDIF
 
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
@@ -180 +155 @@
    END SUBROUTINE p2z_sed_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p2z_sed( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt
-   END SUBROUTINE p2z_sed
-#endif 
-
    !!======================================================================
 END MODULE  p2zsed

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

@@ -6 +6 @@
    !! History :   1.0  !            M. Levy
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
-   !!----------------------------------------------------------------------
-#if defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces_reduced'                              LOBSTER bio-model
    !!----------------------------------------------------------------------
    !!   p2zsms        :  Time loop of passive tracers sms
@@ -72 +68 @@
    END SUBROUTINE p2z_sms
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                     No passive tracer
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p2z_sms( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p2z_sms: You should not have seen this print! error?', kt
-   END SUBROUTINE p2z_sms
-#endif 
-
    !!======================================================================
 END MODULE p2zsms

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

@@ -6 +6 @@
    !! History :   1.0  !  2004     (O. Aumont) Original code
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
    !!----------------------------------------------------------------------
    !!   p4z_bio        :   computes the interactions between the different
@@ -24 +20 @@
    USE p4zmicro        !  Sources and sinks of microzooplankton
    USE p4zmeso         !  Sources and sinks of mesozooplankton
+   USE p5zlim          !  Co-limitations of differents nutrients
+   USE p5zprod         !  Growth rate of the 2 phyto groups
+   USE p5zmort         !  Mortality terms for phytoplankton
+   USE p5zmicro        !  Sources and sinks of microzooplankton
+   USE p5zmeso         !  Sources and sinks of mesozooplankton
    USE p4zrem          !  Remineralisation of organic matter
+   USE p4zpoc          !  Remineralization of organic particles
+   USE p4zagg          !  Aggregation of particles
    USE p4zfechem
+   USE p4zligand       !  Prognostic ligand model
    USE prtctl_trc      !  print control for debugging
    USE iom             !  I/O manager
@@ -73 +77 @@
       END DO
 
-      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column
-      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter
-      CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging
-      CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
-      CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
-      !                             ! (for each element : C, Si, Fe, Chl )
-      CALL p4z_mort ( kt      )     ! phytoplankton mortality
-     !                             ! zooplankton sources/sinks routines 
-      CALL p4z_micro( kt, knt )           ! microzooplankton
-      CALL p4z_meso ( kt, knt )           ! mesozooplankton
-      CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
-      !                             ! test if tracers concentrations fall below 0.
+      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column
+      CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter
+      CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging
+      !
+      IF( ln_p4z ) THEN
+         CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+         CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
+         !                             ! (for each element : C, Si, Fe, Chl )
+         CALL p4z_mort ( kt      )     ! phytoplankton mortality
+         !                             ! zooplankton sources/sinks routines 
+         CALL p4z_micro( kt, knt )           ! microzooplankton
+         CALL p4z_meso ( kt, knt )           ! mesozooplankton
+      ELSE
+         CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients
+         CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean. 
+         !                             ! (for each element : C, Si, Fe, Chl )
+         CALL p5z_mort ( kt      )     ! phytoplankton mortality
+         !                             ! zooplankton sources/sinks routines 
+         CALL p5z_micro( kt, knt )           ! microzooplankton
+         CALL p5z_meso ( kt, knt )           ! mesozooplankton
+      ENDIF
+      !
+      CALL p4z_agg  ( kt, knt )     ! Aggregation of particles
+      CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe
+      CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles
+      IF( ln_ligand ) THEN
+        CALL p4z_ligand( kt, knt )
+      ENDIF
       !                                                             !
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
@@ -96 +116 @@
    END SUBROUTINE p4z_bio
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_bio                         ! Empty routine
-   END SUBROUTINE p4z_bio
-#endif 
-
    !!======================================================================
 END MODULE p4zbio

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

@@ -11 +11 @@
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
    !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
+   !!             3.6  !  2016-03  (O. Aumont) Change chemistry to MOCSY standards
    !!----------------------------------------------------------------------
    !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol
@@ -22 +19 @@
    USE sms_pisces    !  PISCES Source Minus Sink variables
    USE lib_mpp       !  MPP library
+   USE eosbn2, ONLY : neos
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   p4z_che         !
-   PUBLIC   p4z_che_alloc   !
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2   ! Solubilities of O2 and CO2
+   PUBLIC   p4z_che          !
+   PUBLIC   p4z_che_alloc    !
+   PUBLIC   ahini_for_at     !
+   PUBLIC   solve_at_general !
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: sio3eq   ! chemistry of Si
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: fekeq    ! chemistry of Fe
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemc    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemo2    ! Solubilities of O2 and CO2
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol    ! solubility of Fe
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   salinprac  ! Practical salinity
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ???
+
+   !!* Variable for chemistry of the CO2 cycle
 
    REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm
 
-   REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)
    REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )  
 
-   REAL(wp) ::   rgas   = 83.14472       ! universal gas constants
-   REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles
-
-   REAL(wp) ::   bor1   = 0.00023        ! borat constants
-   REAL(wp) ::   bor2   = 1. / 10.82
-
-   REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate
-   REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966)
-
-   REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides
-   REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 )
-
-   !                                    ! volumetric solubility constants for o2 in ml/L  
-   REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992.
-   REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure
-   REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but 
-   REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2)
-   REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2
-   REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension.
-   REAL(wp) ::   ox6    = -6.24097e-3   
-   REAL(wp) ::   ox7    = -6.93498e-3 
-   REAL(wp) ::   ox8    = -6.90358e-3
-   REAL(wp) ::   ox9    = -4.29155e-3 
-   REAL(wp) ::   ox10   = -3.11680e-7 
+   REAL(wp) ::   rgas   = 83.14472      ! universal gas constants
+   REAL(wp) ::   oxyco  = 1. / 22.4144  ! converts from liters of an ideal gas to moles
 
    !                                    ! coeff. for seawater pressure correction : millero 95
    !                                    ! AGRIF doesn't like the DATA instruction
-   REAL(wp) :: devk11  = -25.5
-   REAL(wp) :: devk12  = -15.82
-   REAL(wp) :: devk13  = -29.48
-   REAL(wp) :: devk14  = -25.60
-   REAL(wp) :: devk15  = -48.76
+   REAL(wp) :: devk10  = -25.5
+   REAL(wp) :: devk11  = -15.82
+   REAL(wp) :: devk12  = -29.48
+   REAL(wp) :: devk13  = -20.02
+   REAL(wp) :: devk14  = -18.03
+   REAL(wp) :: devk15  = -9.78
+   REAL(wp) :: devk16  = -48.76
+   REAL(wp) :: devk17  = -14.51
+   REAL(wp) :: devk18  = -23.12
+   REAL(wp) :: devk19  = -26.57
+   REAL(wp) :: devk110  = -29.48
    !
-   REAL(wp) :: devk21  = 0.1271
-   REAL(wp) :: devk22  = -0.0219
-   REAL(wp) :: devk23  = 0.1622
-   REAL(wp) :: devk24  = 0.2324
-   REAL(wp) :: devk25  = 0.5304
+   REAL(wp) :: devk20  = 0.1271
+   REAL(wp) :: devk21  = -0.0219
+   REAL(wp) :: devk22  = 0.1622
+   REAL(wp) :: devk23  = 0.1119
+   REAL(wp) :: devk24  = 0.0466
+   REAL(wp) :: devk25  = -0.0090
+   REAL(wp) :: devk26  = 0.5304
+   REAL(wp) :: devk27  = 0.1211
+   REAL(wp) :: devk28  = 0.1758
+   REAL(wp) :: devk29  = 0.2020
+   REAL(wp) :: devk210  = 0.1622
    !
+   REAL(wp) :: devk30  = 0.
    REAL(wp) :: devk31  = 0.
-   REAL(wp) :: devk32  = 0.
-   REAL(wp) :: devk33  = 2.608E-3
-   REAL(wp) :: devk34  = -3.6246E-3
-   REAL(wp) :: devk35  = 0.
+   REAL(wp) :: devk32  = 2.608E-3
+   REAL(wp) :: devk33  = -1.409e-3
+   REAL(wp) :: devk34  = 0.316e-3
+   REAL(wp) :: devk35  = -0.942e-3
+   REAL(wp) :: devk36  = 0.
+   REAL(wp) :: devk37  = -0.321e-3
+   REAL(wp) :: devk38  = -2.647e-3
+   REAL(wp) :: devk39  = -3.042e-3
+   REAL(wp) :: devk310  = -2.6080e-3
    !
-   REAL(wp) :: devk41  = -3.08E-3
-   REAL(wp) :: devk42  = 1.13E-3
-   REAL(wp) :: devk43  = -2.84E-3
-   REAL(wp) :: devk44  = -5.13E-3
-   REAL(wp) :: devk45  = -11.76E-3
+   REAL(wp) :: devk40  = -3.08E-3
+   REAL(wp) :: devk41  = 1.13E-3
+   REAL(wp) :: devk42  = -2.84E-3
+   REAL(wp) :: devk43  = -5.13E-3
+   REAL(wp) :: devk44  = -4.53e-3
+   REAL(wp) :: devk45  = -3.91e-3
+   REAL(wp) :: devk46  = -11.76e-3
+   REAL(wp) :: devk47  = -2.67e-3
+   REAL(wp) :: devk48  = -5.15e-3
+   REAL(wp) :: devk49  = -4.08e-3
+   REAL(wp) :: devk410  = -2.84e-3
    !
-   REAL(wp) :: devk51  = 0.0877E-3
-   REAL(wp) :: devk52  = -0.1475E-3     
-   REAL(wp) :: devk53  = 0.
-   REAL(wp) :: devk54  = 0.0794E-3      
-   REAL(wp) :: devk55  = 0.3692E-3      
+   REAL(wp) :: devk50  = 0.0877E-3
+   REAL(wp) :: devk51  = -0.1475E-3     
+   REAL(wp) :: devk52  = 0.
+   REAL(wp) :: devk53  = 0.0794E-3      
+   REAL(wp) :: devk54  = 0.09e-3
+   REAL(wp) :: devk55  = 0.054e-3
+   REAL(wp) :: devk56  = 0.3692E-3
+   REAL(wp) :: devk57  = 0.0427e-3
+   REAL(wp) :: devk58  = 0.09e-3
+   REAL(wp) :: devk59  = 0.0714e-3
+   REAL(wp) :: devk510  = 0.0
+   !
+   ! General parameters
+   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp
+   REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp
+
+   ! Maximum number of iterations for each method
+   INTEGER, PARAMETER :: jp_maxniter_atgen    = 20
+
+   ! Bookkeeping variables for each method
+   ! - SOLVE_AT_GENERAL
+   INTEGER :: niter_atgen    = jp_maxniter_atgen
 
    !!----------------------------------------------------------------------
@@ -113 +147 @@
       !!---------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   ztkel, zt   , zt2   , zsal  , zsal2 , zbuf1 , zbuf2
+      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2
       REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5
       REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2
       REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat
-      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1  , za2
+      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1, za2
       REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw
+      REAL(wp) ::   zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi
       REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1
+      REAL(wp) ::   total2free, free2SWS, total2SWS, SWS2total
+
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_che')
+      !
+      ! Computation of chemical constants require practical salinity
+      ! Thus, when TEOS08 is used, absolute salinity is converted to 
+      ! practical salinity
+      ! -------------------------------------------------------------
+      IF (neos == -1) THEN
+         salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504
+      ELSE
+         salinprac(:,:,:) = tsn(:,:,:,jp_sal)
+      ENDIF
+
       !
       ! Computations of chemical constants require in situ temperature
@@ -133 +181 @@
             DO ji = 1, jpi
                zpres = gdept_n(ji,jj,jk) / 1000.
-               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) )
+               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )
                za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 )
                tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2
@@ -142 +190 @@
       ! CHEMICAL CONSTANTS - SURFACE LAYER
       ! ----------------------------------
+!CDIR NOVERRCHK
       DO jj = 1, jpj
+!CDIR NOVERRCHK
          DO ji = 1, jpi
             !                             ! SET ABSOLUTE TEMPERATURE
             ztkel = tempis(ji,jj,1) + 273.15
             zt    = ztkel * 0.01
-            zt2   = zt * zt
-            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.
-            zsal2 = zsal * zsal
-            zlogt = LOG( zt )
+            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
             !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980)
             !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
             zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    &
             &       + 0.0047036e-4*ztkel**2)
-            !                             ! SET SOLUBILITIES OF O2 AND CO2 
-            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm)
+            chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm)
             chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3
             chemc(ji,jj,3) = 57.7 - 0.118*ztkel
@@ -165 +211 @@
       ! OXYGEN SOLUBILITY - DEEP OCEAN
       ! -------------------------------
+!CDIR NOVERRCHK
       DO jk = 1, jpk
+!CDIR NOVERRCHK
          DO jj = 1, jpj
+!CDIR NOVERRCHK
             DO ji = 1, jpi
               ztkel = tempis(ji,jj,jk) + 273.15
-              zsal  = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.
+              zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35.
               zsal2 = zsal * zsal
               ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature
@@ -176 +225 @@
               ztgg4 = ztgg3 * ztgg
               ztgg5 = ztgg4 * ztgg
-              zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   &
-                     + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2
+
+              zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    &
+              &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   &
+              &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   &
+              &       - 3.11680e-7 * zsal2
               chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm)
             END DO
@@ -187 +239 @@
       ! CHEMICAL CONSTANTS - DEEP OCEAN
       ! -------------------------------
+!CDIR NOVERRCHK
       DO jk = 1, jpk
+!CDIR NOVERRCHK
          DO jj = 1, jpj
+!CDIR NOVERRCHK
             DO ji = 1, jpi
 
@@ -199 +254 @@
                ! SET ABSOLUTE TEMPERATURE
                ztkel   = tempis(ji,jj,jk) + 273.15
-               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.
+               zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35.
                zsqrt  = SQRT( zsal )
                zsal15  = zsqrt * zsal
@@ -210 +265 @@
 
                ! CHLORINITY (WOOSTER ET AL., 1969)
-               zcl     = zsal * salchl
+               zcl     = zsal / 1.80655
 
                ! TOTAL SULFATE CONCENTR. [MOLES/kg soln]
-               zst     = st1 * zcl * st2
+               zst     = 0.14 * zcl /96.062
 
                ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln]
-               zft     = ft1 * zcl * ft2
+               zft     = 0.000067 * zcl /18.9984
 
                ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990)
@@ -224 +279 @@
                &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         &
                &         + LOG(1.0 - 0.001005 * zsal))
-               !
-               aphscale(ji,jj,jk) = ( 1. + zst / zcks )
 
                ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79)
@@ -239 +292 @@
                &      * zlogt + 0.053105*zsqrt*ztkel
 
-
                ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 
                ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale
@@ -247 +299 @@
                   - 0.01781*zsal + 0.0001122*zsal*zsal)
 
-               ! PKW (H2O) (DICKSON AND RILEY, 1979)
-               zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt    & 
-               &     + (118.67*ztr - 5.977 + 1.0495 * zlogt)        &
-               &     * zsqrt - 0.01615 * zsal
+               ! PKW (H2O) (MILLERO, 1995) from composite data
+               zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    &
+                         - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal
+
+               ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995)
+              zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   &
+              &          + (-106.736*ztr + 0.69171) * zsqrt       &
+              &          + (-0.65643*ztr - 0.01844) * zsal
+
+              zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  &
+              &          + (-160.340*ztr + 1.3566)*zsqrt          &
+              &          + (0.37335*ztr - 0.05778)*zsal
+
+              zck3p    = -3070.75*ztr - 18.126                    &
+              &          + (17.27039*ztr + 2.81197) * zsqrt       &
+              &          + (-44.99486*ztr - 0.09984) * zsal 
+
+              ! CONSTANT FOR SILICATE, MILLERO (1995)
+              zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   &
+              &          + (-458.79*ztr + 3.5913) * zisqrt       &
+              &          + (188.74*ztr - 1.5998) * zis           &
+              &          + (-12.1652*ztr + 0.07871) * zis2       &
+              &          + LOG(1.0 - 0.001005*zsal)
 
                ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER
@@ -258 +329 @@
                   &      - 0.07711*zsal + 0.0041249*zsal15
 
+               ! CONVERT FROM DIFFERENT PH SCALES
+               total2free  = 1.0/(1.0 + zst/zcks)
+               free2SWS    = 1. + zst/zcks + zft/(zckf*total2free)
+               total2SWS   = total2free * free2SWS
+               SWS2total   = 1.0 / total2SWS
+
                ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?)
-               zak1    = 10**(zck1)
-               zak2    = 10**(zck2)
-               zakb    = EXP( zckb  )
+               zak1    = 10**(zck1) * total2SWS
+               zak2    = 10**(zck2) * total2SWS
+               zakb    = EXP( zckb ) * total2SWS
                zakw    = EXP( zckw )
                zaksp1  = 10**(zaksp0)
+               zak1p   = exp( zck1p )
+               zak2p   = exp( zck2p )
+               zak3p   = exp( zck3p )
+               zaksi   = exp( zcksi )
+               zckf    = zckf * total2SWS
 
                ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970)
@@ -275 +357 @@
                !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE
                !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285))
-               zcpexp  = zpres /(rgas*ztkel)
-               zcpexp2 = zpres * zpres/(rgas*ztkel)
+               zcpexp  = zpres / (rgas*ztkel)
+               zcpexp2 = zpres * zcpexp
 
                ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE
@@ -282 +364 @@
                !        (CF. BROECKER ET AL., 1982)
 
-               zbuf1  = -     ( devk11 + devk21 * ztc + devk31 * ztc * ztc )
+               zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk40 + devk50 * ztc )
+               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc )
                zbuf2  = 0.5 * ( devk41 + devk51 * ztc )
-               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
 
                zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc )
                zbuf2  = 0.5 * ( devk42 + devk52 * ztc )
-               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
 
                zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc )
                zbuf2  = 0.5 * ( devk43 + devk53 * ztc )
-               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
 
                zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc )
                zbuf2  = 0.5 * ( devk44 + devk54 * ztc )
-               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
-
+               aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk45 + devk55 * ztc )
+               akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk47 + devk57 * ztc )
+               ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk48 + devk58 * ztc )
+               ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk49 + devk59 * ztc )
+               ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk410 + devk510 * ztc )
+               aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               ! CONVERT FROM DIFFERENT PH SCALES
+               total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk))
+               free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk)
+               total2SWS   = total2free * free2SWS
+               SWS2total   = 1.0 / total2SWS
+
+               ! Convert to total scale
+               ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total
+               ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total
+               akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total
+               akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total
+               ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total
+               ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total
+               ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total
+               aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total
+               akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free
 
                ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 
                !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO
                !        (P. 1285) AND BERNER (1976)
-               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc )
-               zbuf2  = 0.5 * ( devk45 + devk55 * ztc )
+               zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc )
+               zbuf2  = 0.5 * ( devk46 + devk56 * ztc )
                aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
 
-               ! TOTAL BORATE CONCENTR. [MOLES/L]
-               borat(ji,jj,jk) = bor1 * zcl * bor2
+               ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L]
+               borat(ji,jj,jk) = 0.0002414 * zcl / 10.811
+               sulfat(ji,jj,jk) = zst
+               fluorid(ji,jj,jk) = zft 
 
                ! Iron and SIO3 saturation concentration from ...
                sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6
-               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) )
-
+               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel )
+
+               ! Liu and Millero (1999) only valid 5 - 50 degC
+               ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16
+               fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1)
+               fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 )
+               fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 )
+               fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 )
+               fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 )
             END DO
          END DO
@@ -321 +452 @@
    END SUBROUTINE p4z_che
 
+   SUBROUTINE ahini_for_at(p_hini)
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE ahini_for_at  ***
+      !!
+      !! Subroutine returns the root for the 2nd order approximation of the
+      !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic 
+      !! polynomial) around the local minimum, if it exists.
+      !! Returns * 1E-03_wp if p_alkcb <= 0
+      !!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot
+      !!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot
+      !!                    and the 2nd order approximation does not have 
+      !!                    a solution
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini
+      INTEGER  ::   ji, jj, jk
+      REAL(wp)  ::  zca1, zba1
+      REAL(wp)  ::  zd, zsqrtd, zhmin
+      REAL(wp)  ::  za2, za1, za0
+      REAL(wp)  ::  p_dictot, p_bortot, p_alkcb 
+
+      IF( nn_timing == 1 )  CALL timing_start('ahini_for_at')
+      !
+      DO jk = 1, jpk
+        DO jj = 1, jpj
+          DO ji = 1, jpi
+            p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
+            p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn)
+            p_bortot = borat(ji,jj,jk)
+            IF (p_alkcb <= 0.) THEN
+                p_hini(ji,jj,jk) = 1.e-3
+            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN
+                p_hini(ji,jj,jk) = 1.e-10_wp
+            ELSE
+                zca1 = p_dictot/( p_alkcb + rtrn )
+                zba1 = p_bortot/ (p_alkcb + rtrn )
+           ! Coefficients of the cubic polynomial
+                za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1)
+                za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    &
+                &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1))
+                za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1))
+                                        ! Taylor expansion around the minimum
+                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation
+                                        ! for the minimum close to the root
+
+                IF(zd > 0.) THEN        ! If the discriminant is positive
+                  zsqrtd = SQRT(zd)
+                  IF(za2 < 0) THEN
+                    zhmin = (-za2 + zsqrtd)/3.
+                  ELSE
+                    zhmin = -za1/(za2 + zsqrtd)
+                  ENDIF
+                  p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd)
+                ELSE
+                  p_hini(ji,jj,jk) = 1.e-7
+                ENDIF
+             !
+             ENDIF
+          END DO
+        END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ahini_for_at')
+      !
+   END SUBROUTINE ahini_for_at
+
+   !===============================================================================
+   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )
+
+   ! Subroutine returns the lower and upper bounds of "non-water-selfionization"
+   ! contributions to total alkalinity (the infimum and the supremum), i.e
+   ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+])
+
+   ! Argument variables
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup
+
+   p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  &
+   &              - fluorid(:,:,:)
+   p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    &
+   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 
+
+   END SUBROUTINE anw_infsup
+
+
+   SUBROUTINE solve_at_general( p_hini, zhi )
+
+   ! Universal pH solver that converges from any given initial value,
+   ! determines upper an lower bounds for the solution if required
+
+   ! Argument variables
+   !--------------------
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini
+   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi
+
+   ! Local variables
+   !-----------------
+   INTEGER   ::  ji, jj, jk, jn
+   REAL(wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor
+   REAL(wp)  ::  zdelta, zh_delta
+   REAL(wp)  ::  zeqn, zdeqndh, zalka
+   REAL(wp)  ::  aphscale
+   REAL(wp)  ::  znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic
+   REAL(wp)  ::  znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor
+   REAL(wp)  ::  znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4
+   REAL(wp)  ::  znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil
+   REAL(wp)  ::  znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4
+   REAL(wp)  ::  znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu
+   REAL(wp)  ::  zalk_wat, zdalk_wat
+   REAL(wp)  ::  zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit
+   LOGICAL   ::  l_exitnow
+   REAL(wp), PARAMETER :: pz_exp_threshold = 1.0
+   REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin
+
+   IF( nn_timing == 1 )  CALL timing_start('solve_at_general')
+      !  Allocate temporary workspace
+   CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )
+   CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )
+
+   CALL anw_infsup( zalknw_inf, zalknw_sup )
+
+   rmask(:,:,:) = tmask(:,:,:)
+   zhi(:,:,:)   = 0.
+
+   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree
+   DO jk = 1, jpk
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (rmask(ji,jj,jk) == 1.) THEN
+               p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)
+               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+               zh_ini = p_hini(ji,jj,jk)
+
+               zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+               IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN
+                 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) )
+               ELSE
+                 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+               ENDIF
+
+               zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale
+
+               IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN
+                 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2.
+               ELSE
+                 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) )
+               ENDIF
+
+               zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk))
+            ENDIF
+         END DO
+      END DO
+   END DO
+
+   zeqn_absmin(:,:,:) = HUGE(1._wp)
+
+   DO jn = 1, jp_maxniter_atgen 
+   DO jk = 1, jpk
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (rmask(ji,jj,jk) == 1.) THEN
+               zfact = rhop(ji,jj,jk) / 1000. + rtrn
+               p_alktot = trb(ji,jj,jk,jptal) / zfact
+               zdic  = trb(ji,jj,jk,jpdic) / zfact
+               zbot  = borat(ji,jj,jk)
+               zpt = trb(ji,jj,jk,jppo4) / zfact * po4r
+               zsit = trb(ji,jj,jk,jpsil) / zfact
+               zst = sulfat (ji,jj,jk)
+               zft = fluorid(ji,jj,jk)
+               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk)
+               zh = zhi(ji,jj,jk)
+               zh_prev = zh
+
+               ! H2CO3 - HCO3 - CO3 : n=2, m=0
+               znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)
+               zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh)
+               zalk_dic   = zdic * (znumer_dic/zdenom_dic)
+               zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     &
+                             *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk))
+               zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2)
+
+
+               ! B(OH)3 - B(OH)4 : n=1, m=0
+               znumer_bor = akb3(ji,jj,jk)
+               zdenom_bor = akb3(ji,jj,jk) + zh
+               zalk_bor   = zbot * (znumer_bor/zdenom_bor)
+               zdnumer_bor = akb3(ji,jj,jk)
+               zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2)
+
+
+               ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1
+               znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+               &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk))
+               zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     &
+               &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh))
+               zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1
+               zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  &
+               &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         &
+               &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         &
+               &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                &
+               &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) )
+               zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2)
+
+               ! H4SiO4 - H3SiO4 : n=1, m=0
+               znumer_sil = aksi3(ji,jj,jk)
+               zdenom_sil = aksi3(ji,jj,jk) + zh
+               zalk_sil   = zsit * (znumer_sil/zdenom_sil)
+               zdnumer_sil = aksi3(ji,jj,jk)
+               zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2)
+
+               ! HSO4 - SO4 : n=1, m=1
+               aphscale = 1.0 + zst/aks3(ji,jj,jk)
+               znumer_so4 = aks3(ji,jj,jk) * aphscale
+               zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh
+               zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.)
+               zdnumer_so4 = aks3(ji,jj,jk)
+               zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2)
+
+               ! HF - F : n=1, m=1
+               znumer_flu =  akf3(ji,jj,jk)
+               zdenom_flu =  akf3(ji,jj,jk) + zh
+               zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.)
+               zdnumer_flu = akf3(ji,jj,jk)
+               zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2)
+
+               ! H2O - OH
+               aphscale = 1.0 + zst/aks3(ji,jj,jk)
+               zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale
+               zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale
+
+               ! CALCULATE [ALK]([CO3--], [HCO3-])
+               zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   &
+               &      + zalk_so4 + zalk_flu                       &
+               &      + zalk_wat - p_alktot
+
+               zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   &
+               &       + zalk_so4 + zalk_flu + zalk_wat)
+
+               zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil &
+               &         + zdalk_so4 + zdalk_flu + zdalk_wat
+
+               ! Adapt bracketing interval
+               IF(zeqn > 0._wp) THEN
+                 zh_min(ji,jj,jk) = zh_prev
+               ELSEIF(zeqn < 0._wp) THEN
+                 zh_max(ji,jj,jk) = zh_prev
+               ENDIF
+
+               IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN
+               ! if the function evaluation at the current point is
+               ! not decreasing faster than with a bisection step (at least linearly)
+               ! in absolute value take one bisection step on [ph_min, ph_max]
+               ! ph_new = (ph_min + ph_max)/2d0
+               !
+               ! In terms of [H]_new:
+               ! [H]_new = 10**(-ph_new)
+               !         = 10**(-(ph_min + ph_max)/2d0)
+               !         = SQRT(10**(-(ph_min + phmax)))
+               !         = SQRT(zh_max * zh_min)
+                  zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk))
+                  zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below
+               ELSE
+               ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH
+               !           = -zdeqndh * LOG(10) * [H]
+               ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10))
+               !
+               ! pH_new = pH_old + \deltapH
+               !
+               ! [H]_new = 10**(-pH_new)
+               !         = 10**(-pH_old - \Delta pH)
+               !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10)))
+               !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10)))
+               !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old))
+
+                  zh_lnfactor = -zeqn/(zdeqndh*zh_prev)
+
+                  IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN
+                     zh          = zh_prev*EXP(zh_lnfactor)
+                  ELSE
+                     zh_delta    = zh_lnfactor*zh_prev
+                     zh          = zh_prev + zh_delta
+                  ENDIF
+
+                  IF( zh < zh_min(ji,jj,jk) ) THEN
+                     ! if [H]_new < [H]_min
+                     ! i.e., if ph_new > ph_max then
+                     ! take one bisection step on [ph_prev, ph_max]
+                     ! ph_new = (ph_prev + ph_max)/2d0
+                     ! In terms of [H]_new:
+                     ! [H]_new = 10**(-ph_new)
+                     !         = 10**(-(ph_prev + ph_max)/2d0)
+                     !         = SQRT(10**(-(ph_prev + phmax)))
+                     !         = SQRT([H]_old*10**(-ph_max))
+                     !         = SQRT([H]_old * zh_min)
+                     zh                = SQRT(zh_prev * zh_min(ji,jj,jk))
+                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+                  ENDIF
+
+                  IF( zh > zh_max(ji,jj,jk) ) THEN
+                     ! if [H]_new > [H]_max
+                     ! i.e., if ph_new < ph_min, then
+                     ! take one bisection step on [ph_min, ph_prev]
+                     ! ph_new = (ph_prev + ph_min)/2d0
+                     ! In terms of [H]_new:
+                     ! [H]_new = 10**(-ph_new)
+                     !         = 10**(-(ph_prev + ph_min)/2d0)
+                     !         = SQRT(10**(-(ph_prev + ph_min)))
+                     !         = SQRT([H]_old*10**(-ph_min))
+                     !         = SQRT([H]_old * zhmax)
+                     zh                = SQRT(zh_prev * zh_max(ji,jj,jk))
+                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below
+                  ENDIF
+               ENDIF
+
+               zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk))
+
+               ! Stop iterations once |\delta{[H]}/[H]| < rdel
+               ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel
+               ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)|
+
+               ! Alternatively:
+               ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))|
+               !             ~ 1/LOG(10) * |\Delta [H]|/[H]
+               !             < 1/LOG(10) * rdel
+
+               ! Hence |zeqn/(zdeqndh*zh)| < rdel
+
+               ! rdel <-- pp_rdel_ah_target
+               l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target)
+
+               IF(l_exitnow) THEN 
+                  rmask(ji,jj,jk) = 0.
+               ENDIF
+
+               zhi(ji,jj,jk) =  zh
+
+               IF(jn >= jp_maxniter_atgen) THEN
+                  zhi(ji,jj,jk) = -1._wp
+               ENDIF
+
+            ENDIF
+         END DO
+      END DO
+   END DO
+   END DO
+   !
+   CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask )
+   CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin )
+
+
+   IF( nn_timing == 1 )  CALL timing_stop('solve_at_general')
+
+
+   END SUBROUTINE solve_at_general
 
    INTEGER FUNCTION p4z_che_alloc()
@@ -326 +811 @@
       !!                     ***  ROUTINE p4z_che_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk),   &
-      &         tempis(jpi,jpj,jpk), STAT=p4z_che_alloc )
+      INTEGER ::   ierr(3)        ! Local variables
+      !!----------------------------------------------------------------------
+
+      ierr(:) = 0
+
+      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) )
+
+      ALLOCATE( akb3(jpi,jpj,jpk)     , tempis(jpi, jpj, jpk),       &
+         &      akw3(jpi,jpj,jpk)     , borat (jpi,jpj,jpk)  ,       &
+         &      aks3(jpi,jpj,jpk)     , akf3(jpi,jpj,jpk)    ,       &
+         &      ak1p3(jpi,jpj,jpk)    , ak2p3(jpi,jpj,jpk)   ,       &
+         &      ak3p3(jpi,jpj,jpk)    , aksi3(jpi,jpj,jpk)   ,       &
+         &      fluorid(jpi,jpj,jpk)  , sulfat(jpi,jpj,jpk)  ,       &
+         &      salinprac(jpi,jpj,jpk),                 STAT=ierr(2) )
+
+      ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) )
+
+      !* Variable for chemistry of the CO2 cycle
+      p4z_che_alloc = MAXVAL( ierr )
       !
       IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.')
@@ -333 +835 @@
    END FUNCTION p4z_che_alloc
 
-#else
    !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_che( kt )                   ! Empty routine
-      INTEGER, INTENT(in) ::   kt
-      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt
-   END SUBROUTINE p4z_che
-#endif 
-
-   !!======================================================================
-END MODULE p4zche
+END MODULE  p4zche

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :   3.5  !  2012-07 (O. Aumont, A. Tagliabue, C. Ethe) Original code
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_top'       and                                      TOP models
-   !!   'key_pisces'                                       PISCES bio-model
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
    !!----------------------------------------------------------------------
    !!   p4z_fechem       :  Compute remineralization/scavenging of iron
@@ -18 +14 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zopt          !  optical model
    USE p4zche          !  chemical model
    USE p4zsbc          !  Boundary conditions from sediments
@@ -30 +25 @@
    PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90
 
-   LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker
-   LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker
-   REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron 
-   REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust 
-   REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean 
-
-!!gm Not DOCTOR norm !!!
+   !! * Shared module variables
+   LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker
+   LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker
+   LOGICAL          ::  ln_fecolloid !: boolean for variable colloidal fraction
+   REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron 
+   REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust 
+   REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean 
+   REAL(wp), PUBLIC ::  kfep         !: rate constant for nanoparticle formation
+
    REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth
 
@@ -59 +56 @@
       !!                    and one particulate form (ln_fechem)
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step
-      !
-      INTEGER  ::   ji, jj, jk, jic
-      CHARACTER (len=25) :: charout
+      !
+      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk, jic, jn
       REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac
-      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll
+      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll, fe3sol
       REAL(wp) ::   zdenom1, zscave, zaggdfea, zaggdfeb, zcoag
       REAL(wp) ::   ztrc, zdust
-#if ! defined key_kriest
-      REAL(wp) ::   zdenom, zdenom2
-#endif
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP
+      REAL(wp) ::   zdenom2
+      REAL(wp) ::   zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2
+      REAL(wp) ::   zrum, zcodel, zargu, zlight
       REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand
       REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2
       REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2
-      REAL(wp) :: ztfe, zoxy
-      REAL(wp) :: zstep
+      REAL(wp) :: ztfe, zoxy, zhplus
+      REAL(wp) :: zaggliga, zaggligb
+      REAL(wp) :: dissol, zligco
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zstrn2
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_fechem')
       !
-      CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig )
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )
       zFe3 (:,:,:) = 0.
       zFeL1(:,:,:) = 0.
       zTL1 (:,:,:) = 0.
       IF( ln_fechem ) THEN
-         CALL wrk_alloc( jpi,jpj,jpk,   zFe2, zFeL2, zTL2, zFeP )
+         CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 )
+         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
          zFe2 (:,:,:) = 0.
          zFeL2(:,:,:) = 0.
@@ -100 +102 @@
          ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. )
       ELSE
-         ztotlig(:,:,:) = ligand * 1E9
+        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9
+        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9
+        ENDIF
       ENDIF
 
       IF( ln_fechem ) THEN
+         ! compute the day length depending on latitude and the day
+         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
+         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
+
+         ! day length in hours
+         zstrn(:,:) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
+               zargu = MAX( -1., MIN(  1., zargu ) )
+               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+            END DO
+         END DO
+
+         ! Maximum light intensity
+         zstrn2(:,:) = zstrn(:,:) / 24.
+         WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
+         zstrn(:,:) = 24. / zstrn(:,:)
+
          ! ------------------------------------------------------------
          ! NEW FE CHEMISTRY ROUTINE from Tagliabue and Volker (2009)
@@ -109 +132 @@
          ! Chemistry is supposed to be fast enough to be at equilibrium
          ! ------------------------------------------------------------
-         DO jk = 1, jpkm1
+         DO jn = 1, 2
+          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
+                  zlight = etot(ji,jj,jk) * zstrn(ji,jj) * REAL( 2-jn, wp )
+                  zzstrn2 = zstrn2(ji,jj) * REAL( 2-jn, wp ) + (1. - zstrn2(ji,jj) ) * REAL( jn-1, wp )
                   ! Calculate ligand concentrations : assume 2/3rd of excess goes to
                   ! strong ligands (L1) and 1/3rd to weak ligands (L2)
@@ -118 +144 @@
                   zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand
                   ! ionic strength from Millero et al. 1987
-                  zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn )
                   zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) )
-                  zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 )
+                  zoxy   = trb(ji,jj,jk,jpoxy)
                   ! Fe2+ oxydation rate from Santana-Casiano et al. (2005)
-                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  &
-                    &    - 0.04406 * SQRT( tsn(ji,jj,jk,jp_sal) ) - 0.002847 * tsn(ji,jj,jk,jp_sal)
+                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 )  &
+                    &    - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk)
                   zkox   = ( 10.** zkox ) * spd
                   zkox   = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn )
                   ! PHOTOREDUCTION of complexed iron : Tagliabue and Arrigo (2006)
-                  zkph2 = MAX( 0., 15. * etot(ji,jj,jk) / ( etot(ji,jj,jk) + 2. ) )
+                  zkph2 = MAX( 0., 15. * zlight / ( zlight + 2. ) ) * (1. - fr_i(ji,jj))
                   zkph1 = zkph2 / 5.
                   ! pass the dfe concentration from PISCES
@@ -167 +192 @@
                         zphi = ACOS( zfff )
                         DO jic = 1, 3
-                           zfunc = -2 * zr * COS( zphi / 3. + 2. * FLOAT( jic - 1 ) * rpi / 3. ) - za2 / 3.
+                           zfunc = -2 * zr * COS( zphi / 3. + 2. * REAL( jic - 1, wp ) * rpi / 3. ) - za2 / 3.
                            IF( zfunc > 0. .AND. zfunc <= ztfe)  zxs = zfunc
                         END DO
@@ -173 +198 @@
                   ENDIF
                   ! solve for the other Fe species
-                  zFe3(ji,jj,jk) = MAX( 0., zxs ) 
-                  zFep(ji,jj,jk) = MAX( 0., ( ks * zFe3(ji,jj,jk) / kpr ) )
+                  zzFe3 = MAX( 0., zxs )
+                  zzFep = MAX( 0., ( ks * zzFe3 / kpr ) )
                   zkappa2 = ( kb2 + zkph2 ) / kl2
-                  zFeL2(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * zTL2(ji,jj,jk) ) / ( zkappa2 + zFe3(ji,jj,jk) ) )
-                  zFeL1(ji,jj,jk) = MAX( 0., ( ztfe / zb - za / zb * zFe3(ji,jj,jk) - zc / zb * zFeL2(ji,jj,jk) ) )
-                  zFe2 (ji,jj,jk) = MAX( 0., ( ( zkph1 * zFeL1(ji,jj,jk) + zkph2 * zFeL2(ji,jj,jk) ) / zkox ) )
+                  zzFeL2 = MAX( 0., ( zzFe3 * zTL2(ji,jj,jk) ) / ( zkappa2 + zzFe3 ) )
+                  zzFeL1 = MAX( 0., ( ztfe / zb - za / zb * zzFe3 - zc / zb * zzFeL2 ) )
+                  zzFe2  = MAX( 0., ( ( zkph1 * zzFeL1 + zkph2 * zzFeL2 ) / zkox ) )
+                  zFe3(ji,jj,jk)  = zFe3(ji,jj,jk)  + zzFe3 * zzstrn2
+                  zFe2(ji,jj,jk)  = zFe2(ji,jj,jk)  + zzFe2 * zzstrn2
+                  zFeL2(ji,jj,jk) = zFeL2(ji,jj,jk) + zzFeL2 * zzstrn2
+                  zFeL1(ji,jj,jk) = zFeL1(ji,jj,jk) + zzFeL1 * zzstrn2
+                  zFeP(ji,jj,jk)  = zFeP(ji,jj,jk)  + zzFeP * zzstrn2
                END DO
             END DO
+         END DO
          END DO
       ELSE
@@ -206 +237 @@
          !
       ENDIF
-      !
+
       zdust = 0.         ! if no dust available
-      !
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zstep = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
                ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water. 
                ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]).
@@ -224 +250 @@
                   zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9
                ELSE
-                  zfeequi = zFe3(ji,jj,jk) * 1E-9 
-                  zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
+                  zfeequi = zFe3(ji,jj,jk) * 1E-9
+                  IF (ln_fecolloid) THEN
+                     zhplus   = max( rtrn, hi(ji,jj,jk) )
+                     fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  &
+                     &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     &
+                     &         + fesol(ji,jj,jk,5) / zhplus )
+                     zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) )
+                  ELSE
+                     zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9
+                     fe3sol  = 0.
+                  ENDIF
                ENDIF
-#if defined key_kriest
-               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
-#else
+               !
                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6 
-#endif
                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s
                zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc
-               zscave = zfeequi * zlam1b * zstep
+               zscave = zfeequi * zlam1b * xstep
 
                ! Compute the different ratios for scavenging of iron
@@ -240 +272 @@
                ! ---------------------------------------------------------
                zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b
-#if ! defined key_kriest
                zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b
-#endif
 
                !  Increased scavenging for very high iron concentrations found near the coasts 
@@ -249 +279 @@
                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
                zlamfac = MIN( 1.  , zlamfac )
-!!gm very small BUG :  it is unlikely but possible that gdept_n = 0  .....
                zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) )
                zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) )
-               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer)
+               zcoag   = zfeequi * zlam1b * xstep + 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer)
 
                !  Compute the coagulation of colloidal iron. This parameterization 
@@ -259 +288 @@
                !  ----------------------------------------------------------------
                zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
-                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) )
-               zaggdfea = zlam1a * zstep * zfecoll
-#if defined key_kriest
-               zaggdfeb = 0.
+                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+               zaggdfea = zlam1a * xstep * zfecoll
                !
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb
-#else
                zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
-               zaggdfeb = zlam1b * zstep * zfecoll
+               zaggdfeb = zlam1b * xstep * zfecoll
                !
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag
+               ! precipitation of Fe3+, creation of nanoparticles
+               precip(ji,jj,jk) = MAX( 0., ( zfeequi - fe3sol ) ) * kfep * xstep
+               !
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb &
+               &                     - zcoag - precip(ji,jj,jk)
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb
-#endif
+               !
             END DO
          END DO
@@ -280 +308 @@
       !  Define the bioavailable fraction of iron
       !  ----------------------------------------
-      IF( ln_fechem ) THEN
-          biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
-      ELSE
-          biron(:,:,:) = trb(:,:,:,jpfer) 
-      ENDIF
-
+      IF( ln_fechem ) THEN  ;  biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 )
+      ELSE                  ;  biron(:,:,:) = trb(:,:,:,jpfer) 
+      ENDIF
+      !
+      IF( ln_ligand ) THEN
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    &
+                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) )
+                  !
+                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk)
+                  zligco   = MAX( ( 0.1 * trb(ji,jj,jk,jplgw) ), ( trb(ji,jj,jk,jplgw) - fe3sol ) )
+                  zaggliga = zlam1a * xstep * zligco
+                  zaggligb = zlam1b * xstep * zligco
+                  tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk)
+                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb
+               END DO
+            END DO
+         END DO
+         !
+         IF( .NOT.ln_fechem) THEN
+            plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) )
+            plig(:,:,:) =  MAX( 0. , plig(:,:,:) )
+         ENDIF
+         !
+      ENDIF
       !  Output of some diagnostics variables
       !     ---------------------------------
-      IF( lk_iomput .AND. knt == nrdttrc ) THEN
+      IF( lk_iomput ) THEN
+         IF( knt == nrdttrc ) THEN
          IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+
          IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1
@@ -300 +351 @@
             IF( iom_use("TL2")  ) CALL iom_put("TL2"    , zTL2   (:,:,:)       * tmask(:,:,:) )   ! TL2
          ENDIF
+         ENDIF
       ENDIF
 
@@ -308 +360 @@
       ENDIF
       !
-                       CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig )
-      IF( ln_fechem )  CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
+      CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip )
+      IF( ln_fechem )  THEN
+         CALL wrk_dealloc( jpi, jpj,      zstrn, zstrn2 )
+         CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP )
+      ENDIF
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_fechem')
@@ -328 +383 @@
       !!
       !!----------------------------------------------------------------------
-      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, xlam1, xlamdust, ligand 
+      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep 
       INTEGER :: ios                 ! Local integer output status for namelist read
 
@@ -344 +399 @@
          WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem =', ln_fechem
-         WRITE(numout,*) '    variable concentration of ligand          ln_ligvar =', ln_ligvar
-         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1
-         WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust  =', xlamdust
-         WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand
+         WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem    =', ln_fechem
+         WRITE(numout,*) '    variable concentration of ligand          ln_ligvar    =', ln_ligvar
+         WRITE(numout,*) '    Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid
+         WRITE(numout,*) '    scavenging rate of Iron                   xlam1        =', xlam1
+         WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust     =', xlamdust
+         WRITE(numout,*) '    ligand concentration in the ocean         ligand       =', ligand
+         WRITE(numout,*) '    rate constant for nanoparticle formation  kfep         =', kfep
       ENDIF
       !
@@ -377 +434 @@
       !
    END SUBROUTINE p4z_fechem_init
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_fechem                    ! Empty routine
-   END SUBROUTINE p4z_fechem
-#endif 
-
    !!======================================================================
 END MODULE p4zfechem

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

@@ -11 +11 @@
    !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction 
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
    !!   p4z_flx_init  :   Read the namelist
@@ -26 +22 @@
    USE iom                          !  I/O manager
    USE fldread                      !  read input fields
-#if defined key_cpl_carbon_cycle
-   USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2               
-#endif
 
    IMPLICIT NONE
@@ -48 +41 @@
 
    !                               !!* nampisatm namelist (Atmospheric PRessure) *
-   LOGICAL, PUBLIC ::   ln_presatm  !: ref. pressure: global mean Patm (F) or a constant (F)
-
-   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  patm      ! atmospheric pressure at kt                 [N/m2]
-   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)    ::  sf_patm   ! structure of input fields (file informations, fields read)
-
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux 
+   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F)
+   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F)
+
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2]
+   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read)
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2 
 
@@ -74 +67 @@
       !! ** Method  : 
       !!              - Include total atm P correction via Esbensen & Kushnir (1981) 
-      !!              - Pressure correction NOT done for key_cpl_carbon_cycle
       !!              - Remove Wanninkhof chemical enhancement;
       !!              - Add option for time-interpolation of atcco2.txt  
@@ -85 +77 @@
       REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact
       REAL(wp) ::   zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff
-      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2
+      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2
       REAL(wp) ::   zyr_dec, zdco2dt
       CHARACTER (len=25) :: charout
@@ -100 +92 @@
       !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
 
-      IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
-
-      IF( ln_co2int ) THEN 
+      IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+
+      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN 
          ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values.
          ! Caveats: First column of .txt must be in years, decimal  years preferably. 
@@ -116 +108 @@
       ENDIF
 
-#if defined key_cpl_carbon_cycle
-      satmco2(:,:) = atm_co2(:,:)
-#endif
-
-      DO jm = 1, 10
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
-               zbot  = borat(ji,jj,1)
-               zfact = rhop(ji,jj,1) / 1000. + rtrn
-               zdic  = trb(ji,jj,1,jpdic) / zfact
-               zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
-               zalka = trb(ji,jj,1,jptal) / zfact
-
-               ! CALCULATE [ALK]([CO3--], [HCO3-])
-               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1)    &
-               &       + zbot / ( 1.+ zph / akb3(ji,jj,1) )  )
-
-               ! CALCULATE [H+] AND [H2CO3]
-               zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   &
-                  &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  )
-               zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 )
-               zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact
-               hi(ji,jj,1)   = zah2 * zfact
-            END DO
+      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
+            zfact = rhop(ji,jj,1) / 1000. + rtrn
+            zdic  = trb(ji,jj,1,jpdic)
+            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
+            ! CALCULATE [H2CO3]
+            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2)
          END DO
       END DO
-
 
       ! --------------
@@ -167 +142 @@
             zkgwan = 0.251 * zws
             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
-# if defined key_degrad
-            zkgwan = zkgwan * facvol(ji,jj,1)
-#endif 
             ! compute gas exchange for CO2 and O2
             zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 )
@@ -176 +148 @@
       END DO
 
+
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ztkel     = tsn(ji,jj,1,jp_tem) + 273.15
-            zsal      = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.
+            ztkel = tempis(ji,jj,1) + 273.15
+            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35.
             zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal)
             zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw )
@@ -232 +205 @@
          ENDIF
          IF( iom_use( "Dpo2" ) )  THEN
-           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trn(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)
+           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1)
            CALL iom_put( "Dpo2"  , zw2d )
          ENDIF
@@ -239 +212 @@
          !
          CALL wrk_dealloc( jpi, jpj, zw2d )
-      ELSE
-         IF( ln_diatrc ) THEN
-            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
-            trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 
-            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
-            trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
-         ENDIF
       ENDIF
       !
@@ -287 +253 @@
          WRITE(numout,*) ' '
       ENDIF
-      IF( .NOT.ln_co2int ) THEN
+     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN
          IF(lwp) THEN                         ! control print
             WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2
@@ -293 +259 @@
          ENDIF
          satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2
-      ELSE
+      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN
          IF(lwp)  THEN
             WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname )
@@ -315 +281 @@
          END DO
          CLOSE(numco2)
-      ENDIF
+      ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN
+         IF(lwp)  THEN
+            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file'
+            WRITE(numout,*) ' '
+         ENDIF
+      ELSE
+         IF(lwp)  THEN
+            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file'
+            WRITE(numout,*) ' '
+         ENDIF
+      ENDIF
+
       !
       oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon
@@ -341 +318 @@
       CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
       TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read
-      !!
-      NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir
+      TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read
+      !!
+      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir
 
       !                                         ! ----------------------- !
@@ -361 +339 @@
             WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing'
             WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm
+            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2
             WRITE(numout,*)
          ENDIF
@@ -373 +352 @@
          ENDIF
          !                                         
+         IF( ln_presatmco2 ) THEN
+            ALLOCATE( sf_atmco2(1), STAT=ierr )           !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2
+            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' )
+            !
+            CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' )
+                                   ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1)   )
+            IF( sn_atmco2%ln_tint )  ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) )
+         ENDIF
+         !
          IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file
          !
@@ -382 +370 @@
       ENDIF
       !
+      IF( ln_presatmco2 ) THEN
+         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2
+         satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure
+      ELSE
+         satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file
+      ENDIF
+      !
    END SUBROUTINE p4z_patm
 
+
    INTEGER FUNCTION p4z_flx_alloc()
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_flx_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc )
+      ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc )
       !
       IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays')
       !
    END FUNCTION p4z_flx_alloc
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_flx( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt
-   END SUBROUTINE p4z_flx
-#endif 
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

@@ -7 +7 @@
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_int        :  interpolation and computation of various accessory fields
    !!----------------------------------------------------------------------
@@ -16 +12 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE iom
 
    IMPLICIT NONE
@@ -70 +65 @@
    END SUBROUTINE p4z_int
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_int                   ! Empty routine
-      WRITE(*,*) 'p4z_int: You should not have seen this print! error?'
-   END SUBROUTINE p4z_int
-#endif 
-
    !!======================================================================
 END MODULE p4zint

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

@@ -8 +8 @@
    !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota 
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_lim        :   Compute the nutrients limitation terms 
    !!   p4z_lim_init   :   Read the namelist 
@@ -18 +14 @@
    USE trc             ! Tracers defined
    USE sms_pisces      ! PISCES variables
-   USE p4zopt          ! Optical
    USE iom             !  I/O manager
 
@@ -26 +21 @@
    PUBLIC p4z_lim    
    PUBLIC p4z_lim_init    
+   PUBLIC p4z_lim_alloc
 
    !! * Shared module variables
@@ -48 +44 @@
    REAL(wp), PUBLIC ::  qdfelim     !:  optimal Fe quota for diatoms
    REAL(wp), PUBLIC ::  caco3r      !:  mean rainratio 
+
+   !!* Phytoplankton limitation terms
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbac    !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbacl   !: ??
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ???
 
    ! Coefficient for iron limitation
@@ -224 +237 @@
       !!----------------------------------------------------------------------
 
-      NAMELIST/nampislim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   &
+      NAMELIST/namp4zlim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   &
          &                concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd,          & 
          &                xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin
@@ -230 +243 @@
 
       REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters
-      READ  ( numnatp_ref, nampislim, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist', lwp )
+      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp )
 
       REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters 
-      READ  ( numnatp_cfg, nampislim, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampislim )
+      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zlim )
 
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' '
-         WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim'
+         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r
@@ -268 +281 @@
    END SUBROUTINE p4z_lim_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_lim                   ! Empty routine
-   END SUBROUTINE p4z_lim
-#endif 
+   INTEGER FUNCTION p4z_lim_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p5z_lim_alloc  ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp , ONLY: ctl_warn
+      !!----------------------------------------------------------------------
+
+      !*  Biological arrays for phytoplankton growth
+      ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       &
+         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       &
+         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       &
+         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       &
+         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       &
+         &      xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk),       &
+         &      concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       &
+         &      xlimsi  (jpi,jpj,jpk), STAT=p4z_lim_alloc )
+      !
+      IF( p4z_lim_alloc /= 0 ) CALL ctl_warn('p4z_lim_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_lim_alloc
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

@@ -11 +11 @@
    !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
+   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
    !!----------------------------------------------------------------------
    !!   p4z_lys        :   Compute the CaCO3 dissolution 
@@ -22 +19 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zche          !  Chemical model
    USE prtctl_trc      !  print control for debugging
    USE iom             !  I/O manager
@@ -61 +59 @@
       INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, jn
-      REAL(wp) ::   zalk, zdic, zph, zah2
-      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi
+      REAL(wp) ::   zdispot, zfact, zcalcon
       REAL(wp) ::   zomegaca, zexcess, zexcess0
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat
       !!---------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_lys')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss )
+      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )
       !
       zco3    (:,:,:) = 0.
       zcaldiss(:,:,:) = 0.
+      zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn )
       !     -------------------------------------------
       !     COMPUTE [CO3--] and [H+] CONCENTRATIONS
       !     -------------------------------------------
-      
-      DO jn = 1, 5                               !  BEGIN OF ITERATION
-         !
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfact = rhop(ji,jj,jk) / 1000. + rtrn
-                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+]
-                  zdic  = trb(ji,jj,jk,jpdic) / zfact
-                  zalka = trb(ji,jj,jk,jptal) / zfact
-                  ! CALCULATE [ALK]([CO3--], [HCO3-])
-                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn )  &
-                  &       + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
-                  ! CALCULATE [H+] and [CO3--]
-                  zaldi = zdic - zalk
-                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) )
-                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 )
-                  !
-                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact
-                  hi(ji,jj,jk)   = zah2 * zfact
-               END DO
+
+      CALL solve_at_general(zhinit, zhi)
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   &
+               &                + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
+               hi(ji,jj,jk)   = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
             END DO
          END DO
-         !
-      END DO 
+      END DO
 
       !     ---------------------------------------------------------
@@ -115 +100 @@
                ! DEVIATION OF [CO3--] FROM SATURATION VALUE
                ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
-               zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp )
+               zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp )
                zfact    = rhop(ji,jj,jk) / 1000._wp
                zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
@@ -129 +114 @@
                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
                zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal)
-# if defined key_degrad
-               zdispot = zdispot * facvol(ji,jj,jk)
-# endif
               !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
               !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
               zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
-              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk)
               !
               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk)
@@ -150 +131 @@
          IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3            * tmask(:,:,:) )
          IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
-      ELSE
-         IF( ln_diatrc ) THEN
-            trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:)           * tmask(:,:,:)
-         ENDIF
       ENDIF
       !
@@ -164 +139 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss )
+      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_lys')
@@ -183 +158 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER  ::  ji, jj, jk
       INTEGER  ::  ios                 ! Local integer output status for namelist read
-      REAL(wp) ::  zcaralk, zbicarb, zco3
-      REAL(wp) ::  ztmas, ztmas1
 
       NAMELIST/nampiscal/ kdca, nca
@@ -212 +184 @@
       !
    END SUBROUTINE p4z_lys_init
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_lys( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p4z_lys: You should not have seen this print! error?', kt
-   END SUBROUTINE p4z_lys
-#endif 
    !!======================================================================
 END MODULE p4zlys

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

@@ -8 +8 @@
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_meso       :   Compute the sources/sinks for mesozooplankton
    !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton
@@ -18 +14 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zsink         !  vertical flux of particulate matter due to sinking
-   USE p4zint          !  interpolation and computation of various fields
    USE p4zprod         !  production
    USE prtctl_trc      !  print control for debugging
@@ -70 +64 @@
       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
       REAL(wp) :: zgraze2 , zdenom, zdenom2
-      REAL(wp) :: zfact   , zstep, zfood, zfoodlim, zproport
-      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2
+      REAL(wp) :: zfact   , zfood, zfoodlim, zproport
+      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal
       REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf
       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat, zgrasratn
-#if defined key_kriest
-      REAL znumpoc
-#endif
       REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof
       REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf
@@ -87 +78 @@
       IF( nn_timing == 1 )  CALL timing_start('p4z_meso')
       !
-      IF( lk_iomput ) THEN
-         CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
-         zgrazing(:,:,:) = 0._wp
-      ENDIF
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      zgrazing(:,:,:) = 0._wp
 
       DO jk = 1, jpkm1
@@ -96 +85 @@
             DO ji = 1, jpi
                zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
-# if defined key_degrad
-               zstep     = xstep * facvol(ji,jj,jk)
-# else
-               zstep     = xstep
-# endif
-               zfact     = zstep * tgfunc2(ji,jj,jk) * zcompam
+               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
 
                !  Respiration rates of both zooplankton
@@ -126 +110 @@
                zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
+               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) 
 
                zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2 
@@ -140 +124 @@
                !  ----------------------------------
                !  ----------------------------------
-# if ! defined key_kriest
-               zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      &
+               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)
                zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
-# endif
-               zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     &
+               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
                &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes)
                zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
               !
-# if ! defined key_kriest
               zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
               ! Compute the proportion of filter feeders
@@ -158 +139 @@
               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
               zratio2   = zratio * zratio
-              zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      &
+              zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
                &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
                &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
@@ -171 +152 @@
               &   + zgrazpoc + zgrazffep + zgrazffeg
               zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg
-# else
-              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep
-              ! Compute the proportion of filter feeders
-              zproport  = zgrazffep / ( zgraztot + rtrn )
-              zgrazffep = zproport * zgrazffep
-              zgrazfffp = zproport * zgrazfffp
-              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep
-              zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) + zgrazpoc + zgrazffep
-              zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp
-# endif
 
               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
-              IF( lk_iomput )  zgrazing(ji,jj,jk) = zgraztot
+              zgrazing(ji,jj,jk) = zgraztot
 
               !    Mesozooplankton efficiency
@@ -202 +173 @@
                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz
+               !
                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2
@@ -220 +194 @@
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
 
-               ! calcite production
-               zprcaca = xfracal(ji,jj,jk) * zgrazn
-               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
-               !
-               zprcaca = part2 * zprcaca
-               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
-               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-#if defined key_kriest
-              znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
-              tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2
-              tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      &
-                 &   + zmortzgoc * xkr_dmeso - zgrazffep * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn )
-              tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortzgoc - zgrazfffp - zgrazpof    &
-                 &                 + zgraztotf * unass2
-#else
               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac
+              prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac
+              conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac
+              prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2
+              consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac
               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     &
                  &                + zgraztotf * unass2 - zfracfe
-#endif
+              zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn )
+              zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal
+              ! calcite production
+              zprcaca = xfracal(ji,jj,jk) * zgrazn
+              prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
+              !
+              zprcaca = part2 * zprcaca
+              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
+              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca )
+              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
             END DO
          END DO
@@ -265 +236 @@
       ENDIF
       !
-      IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_meso')
@@ -285 +256 @@
       !!----------------------------------------------------------------------
 
-      NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   &
+      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   &
          &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, &
          &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux
@@ -291 +262 @@
 
       REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
-      READ  ( numnatp_ref, nampismes, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist', lwp )
+      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp )
 
       REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
-      READ  ( numnatp_cfg, nampismes, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampismes )
+      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zmes )
 
 
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' ' 
-         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes'
+         WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2
@@ -327 +298 @@
    END SUBROUTINE p4z_meso_init
 
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_meso                    ! Empty routine
-   END SUBROUTINE p4z_meso
-#endif 
-
    !!======================================================================
 END MODULE p4zmeso

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

@@ -8 +8 @@
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_micro       :   Compute the sources/sinks for microzooplankton
    !!   p4z_micro_init  :   Initialize and read the appropriate namelist
@@ -19 +15 @@
    USE sms_pisces      !  PISCES Source Minus Sink variables
    USE p4zlim          !  Co-limitations
-   USE p4zsink         !  vertical flux of particulate matter due to sinking
-   USE p4zint          !  interpolation and computation of various fields
    USE p4zprod         !  production
    USE iom             !  I/O manager
@@ -71 +65 @@
       REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc
       REAL(wp) :: zgraze  , zdenom, zdenom2
-      REAL(wp) :: zfact   , zstep, zfood, zfoodlim
+      REAL(wp) :: zfact   , zfood, zfoodlim
       REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf
       REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
@@ -83 +77 @@
       IF( nn_timing == 1 )  CALL timing_start('p4z_micro')
       !
-      IF( lk_iomput )  CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
+      CALL wrk_alloc( jpi, jpj, jpk, zgrazing )
       !
       DO jk = 1, jpkm1
@@ -89 +83 @@
             DO ji = 1, jpi
                zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
-               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz
+               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
 
                !  Respiration rates of both zooplankton
@@ -115 +105 @@
                zdenom    = zfoodlim / ( xkgraz + zfoodlim )
                zdenom2   = zdenom / ( zfood + rtrn )
-               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
+               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo) 
 
                zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2 
@@ -130 +120 @@
 
                ! Grazing by microzooplankton
-               IF( ln_diatrc .AND. lk_iomput )  zgrazing(ji,jj,jk) = zgraztot
+               zgrazing(ji,jj,jk) = zgraztot
 
                !    Various remineralization and excretion terms
@@ -148 +138 @@
                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig
+               !
+               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz
+               !
                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer
                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass
                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig
-#if defined key_kriest
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_dmicro
-#endif
                !   Update the arrays TRA which contain the biological sources and sinks
                !   --------------------------------------------------------------------
@@ -170 +161 @@
                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz
+               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf
                !
@@ -180 +173 @@
                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-#if defined key_kriest
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro &
-                                                         - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
-#endif
             END DO
          END DO
       END DO
       !
-      IF( lk_iomput .AND. knt == nrdttrc ) THEN
-         CALL wrk_alloc( jpi, jpj, jpk, zw3d )
-         IF( iom_use( "GRAZ1" ) ) THEN
-            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
-            CALL iom_put( "GRAZ1", zw3d )
+      IF( lk_iomput ) THEN
+         IF( knt == nrdttrc ) THEN
+           CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+           IF( iom_use( "GRAZ1" ) ) THEN
+              zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton
+              CALL iom_put( "GRAZ1", zw3d )
+           ENDIF
+           CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
          ENDIF
-         CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
       ENDIF
       !
@@ -203 +194 @@
       ENDIF
       !
-      IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
+      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_micro')
@@ -224 +215 @@
       !!----------------------------------------------------------------------
 
-      NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, &
+      NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, &
          &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, &
          &                xthresh, xkgraz, epsher, sigma1, unass
@@ -230 +221 @@
 
       REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton
-      READ  ( numnatp_ref, nampiszoo, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in reference namelist', lwp )
+      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp )
 
       REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton
-      READ  ( numnatp_cfg, nampiszoo, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampiszoo )
+      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zzoo )
 
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' '
-         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo'
+         WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part
@@ -261 +252 @@
    END SUBROUTINE p4z_micro_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_micro                    ! Empty routine
-   END SUBROUTINE p4z_micro
-#endif 
-
    !!======================================================================
 END MODULE p4zmicro

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

@@ -7 +7 @@
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_mort       :   Compute the mortality terms for phytoplankton
    !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton
@@ -17 +13 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zsink         !  vertical flux of particulate matter due to sinking
    USE p4zprod         !  Primary productivity 
+   USE p4zlim          !  Phytoplankton limitation terms
    USE prtctl_trc      !  print control for debugging
 
@@ -34 +30 @@
    REAL(wp), PUBLIC :: mprat2  !:
 
-
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -73 +68 @@
       REAL(wp) :: zsizerat, zcompaph
       REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal
-      REAL(wp) :: ztortp , zrespp , zmortp , zstep
+      REAL(wp) :: ztortp , zrespp , zmortp 
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
@@ -84 +79 @@
             DO ji = 1, jpi
                zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
-               zstep    = xstep
-# if defined key_degrad
-               zstep    = zstep * facvol(ji,jj,jk)
-# endif
                !     When highly limited by macronutrients, very small cells 
                !     dominate the community. As a consequence, aggregation
@@ -95 +86 @@
                !     Squared mortality of Phyto similar to a sedimentation term during
                !     blooms (Doney et al. 1996)
-               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
+               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat 
 
                !     Phytoplankton mortality. This mortality loss is slightly
@@ -119 +110 @@
                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
-#if defined key_kriest
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
-#else
                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp
                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp
+               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe
-#endif
             END DO
          END DO
@@ -153 +140 @@
       INTEGER  ::  ji, jj, jk
       REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi
-      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep
+      REAL(wp) ::  zrespp2, ztortp2, zmortp2
       REAL(wp) ::  zlim2, zlim1
       CHARACTER (len=25) :: charout
@@ -176 +163 @@
                !    sticky and coagulate to sink quickly out of the euphotic zone
                !     ------------------------------------------------------------
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
                !  Phytoplankton respiration 
                !     ------------------------
                zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
                zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
-               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
+               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia)
 
                !     Phytoplankton mortality. 
                !     ------------------------
-               ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
+               ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi 
 
                zmortp2 = zrespp2 + ztortp2
@@ -202 +185 @@
                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
-#if defined key_kriest
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2  
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe
-#else
                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2
                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2
+               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2
+               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
-#endif
             END DO
          END DO
@@ -240 +219 @@
       !!----------------------------------------------------------------------
 
-      NAMELIST/nampismort/ wchl, wchld, wchldm, mprat, mprat2
+      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2
       INTEGER :: ios                 ! Local integer output status for namelist read
 
       REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
-      READ  ( numnatp_ref, nampismort, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in reference namelist', lwp )
+      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp )
 
       REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
-      READ  ( numnatp_cfg, nampismort, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampismort )
+      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zmort )
 
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' '
-         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort'
+         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
@@ -265 +244 @@
    END SUBROUTINE p4z_mort_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_mort                    ! Empty routine
-   END SUBROUTINE p4z_mort
-#endif 
-
    !!======================================================================
 END MODULE p4zmort

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

@@ -9 +9 @@
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat
    !!----------------------------------------------------------------------
-#if defined  key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_opt       : light availability in the water column
    !!----------------------------------------------------------------------
@@ -41 +37 @@
    INTEGER  :: ntimes_par                ! number of time steps in a file
    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue)
 
    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
 
-   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
+   REAL(wp), DIMENSION(3,61) ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
    
    !!----------------------------------------------------------------------
@@ -75 +67 @@
       REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp5
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d
       !!---------------------------------------------------------------------
       !
@@ -82 +75 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
-      CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr )
-      CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3 )
+                   CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+                   CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr )
+      IF( ln_p5z ) CALL wrk_alloc( jpi, jpj,      zetmp5 )
+                   CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3, zchl3d )
 
       IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt )
@@ -93 +87 @@
       ze2(:,:,:) = 0._wp
       ze3(:,:,:) = 0._wp
+      !
       !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
-      DO jk = 1, jpkm1                         !  --------------------------------------------------------
+                                               !  --------------------------------------------------------
+                    zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)
+      IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch)
+      !
+      DO jk = 1, jpkm1   
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+               zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6
                zchl = MIN(  10. , MAX( 0.05, zchl )  )
                irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
@@ -120 +119 @@
             ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
          END DO
+         IF( ln_p5z ) THEN
+            DO jk = 1, nksrp      
+              epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            END DO
+         ENDIF
          !
          zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn )
@@ -140 +144 @@
             ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk)
          END DO
+         IF( ln_p5z ) THEN
+            DO jk = 1, nksrp      
+              epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk)
+            END DO
+         ENDIF
          etot_ndcy(:,:,:) =  etot(:,:,:) 
       ENDIF
@@ -155 +164 @@
       ENDIF
       !                                        !* Euphotic depth and level
-      neln(:,:) = 1                            !  ------------------------
-      heup(:,:) = 300.
+      neln   (:,:) = 1                            !  ------------------------
+      heup   (:,:) = gdepw_n(:,:,2)
+      heup_01(:,:) = gdepw_n(:,:,2)
 
       DO jk = 2, nksrp
@@ -166 +176 @@
                  heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth
               ENDIF
+              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN
+                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition)
+              ENDIF
            END DO
         END DO
       END DO
       !
-      heup(:,:) = MIN( 300., heup(:,:) )
+      heup   (:,:) = MIN( 300., heup   (:,:) )
+      heup_01(:,:) = MIN( 300., heup_01(:,:) )
       !                                        !* mean light over the mixed layer
       zdepmoy(:,:)   = 0.e0                    !  -------------------------------
@@ -209 +223 @@
       END DO
       !
+      IF( ln_p5z ) THEN
+         zetmp5 (:,:) = 0.e0
+         DO jk = 1, nksrp
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
+                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production
+                     epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
       IF( lk_iomput ) THEN
         IF( knt == nrdttrc ) THEN
@@ -215 +243 @@
            IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
         ENDIF
-      ELSE
-         IF( ln_diatrc ) THEN        ! save output diagnostics
-            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)
-            trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:)
-         ENDIF
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
-      CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr )
-      CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3 )
+      ENDIF
+      !
+                   CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 )
+                   CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr )
+      IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj,      zetmp5 )
+                   CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3, zchl3d )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
@@ -407 +431 @@
                          enano    (:,:,:) = 0._wp
                          ediat    (:,:,:) = 0._wp
+      IF( ln_p5z     )   epico    (:,:,:) = 0._wp
       IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp
       ! 
@@ -418 +443 @@
       !!                     ***  ROUTINE p4z_opt_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   &
-        &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), &
-        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
-         !
+      !
+      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk),  &
+                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc  ) 
+      !
       IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
       !
    END FUNCTION p4z_opt_alloc
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                   No PISCES bio-model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE p4z_opt                   ! Empty routine
-   END SUBROUTINE p4z_opt
-#endif 
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

@@ -8 +8 @@
    !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups
    !!   p4z_prod_init  :   Initialization of the parameters for growth
@@ -19 +15 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zopt          !  optical model
    USE p4zlim          !  Co-limitations of differents nutrients
    USE prtctl_trc      !  print control for debugging
@@ -33 +28 @@
    !! * Shared module variables
    LOGICAL , PUBLIC ::  ln_newprod      !:
-   REAL(wp), PUBLIC ::  pislope         !:
-   REAL(wp), PUBLIC ::  pislope2        !:
+   REAL(wp), PUBLIC ::  pislopen         !:
+   REAL(wp), PUBLIC ::  pisloped        !:
    REAL(wp), PUBLIC ::  xadap           !:
-   REAL(wp), PUBLIC ::  excret          !:
-   REAL(wp), PUBLIC ::  excret2         !:
+   REAL(wp), PUBLIC ::  excretn          !:
+   REAL(wp), PUBLIC ::  excretd         !:
    REAL(wp), PUBLIC ::  bresp           !:
    REAL(wp), PUBLIC ::  chlcnm          !:
@@ -51 +46 @@
    
    REAL(wp) :: r1_rday                !: 1 / rday
-   REAL(wp) :: texcret                !: 1 - excret 
-   REAL(wp) :: texcret2               !: 1 - excret2        
+   REAL(wp) :: texcretn               !: 1 - excretn 
+   REAL(wp) :: texcretd               !: 1 - excretd        
 
    !!----------------------------------------------------------------------
@@ -75 +70 @@
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2
-      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap
-      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2
-      REAL(wp) ::   zmxltst, zmxlday, zmaxday
-      REAL(wp) ::   zpislopen  , zpislope2n
-      REAL(wp) ::   zrum, zcodel, zargu, zval
+      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn
+      REAL(wp) ::   zprod, zproreg, zproreg2, zprochln, zprochld
+      REAL(wp) ::   zmaxday, zdocprod, zpislopen, zpisloped
+      REAL(wp) ::   zmxltst, zmxlday
+      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n
       REAL(wp) ::   zfact
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn, zw2d
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d   
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zw2d, zmixnano, zmixdiat
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl
       !!---------------------------------------------------------------------
       !
@@ -90 +88 @@
       !
       !  Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  )
-      CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
-      CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )
-      !
-      zprorca (:,:,:) = 0._wp
-      zprorcad(:,:,:) = 0._wp
-      zprofed (:,:,:) = 0._wp
-      zprofen (:,:,:) = 0._wp
-      zprochln(:,:,:) = 0._wp
-      zprochld(:,:,:) = 0._wp
-      zpronew (:,:,:) = 0._wp
-      zpronewd(:,:,:) = 0._wp
-      zprdia  (:,:,:) = 0._wp
-      zprbio  (:,:,:) = 0._wp
-      zprdch  (:,:,:) = 0._wp
-      zprnch  (:,:,:) = 0._wp
-      zysopt  (:,:,:) = 0._wp
+      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn )
+      CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+      CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )
+      !
+      zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
+      zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp
+      zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp
+      zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp 
+      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 
 
       ! Computation of the optimal production
-      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 
-      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 
+      prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 
 
       ! compute the day length depending on latitude and the day
@@ -126 +116 @@
       END DO
 
-      ! Impact of the day duration on phytoplankton growth
+      ! Impact of the day duration and light intermittency on phytoplankton growth
       DO jk = 1, jpkm1
          DO jj = 1 ,jpj
@@ -132 +122 @@
                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                   zval = MAX( 1., zstrn(ji,jj) )
-                  zval = 1.5 * zval / ( 12. + zval )
-                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) )
-                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
+                  IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN
+                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
+                  ENDIF
+                  zmxl_chl(ji,jj,jk) = zval / 24.
+                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
                ENDIF
             END DO
          END DO
       END DO
+
+      zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:)
+      zprdia(:,:,:) = zprbio(:,:,:)
 
       ! Maximum light intensity
       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
-      zstrn(:,:) = 24. / zstrn(:,:)
+
+      ! Computation of the P-I slope for nanos and diatoms
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
+                  zadap       = xadap * ztn / ( 2.+ ztn )
+                  zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
+                  zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
+                  !
+                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  &
+                  &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
+                  !
+                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
+                  &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
+               ENDIF
+            END DO
+         END DO
+      END DO
 
       IF( ln_newprod ) THEN
@@ -148 +162 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! Computation of the P-I slope for nanos and diatoms
                   IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
-                      zadap       = xadap * ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
-                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
-                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
-                      !
-                      zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  &
-                         &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn)
-                      !
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   &
-                         &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn)
-
                       ! Computation of production function for Carbon
                       !  ---------------------------------------------
-                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn)
-                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn)
-                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  )
-                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  )
-
+                      zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
+                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
                       !  Computation of production function for Chlorophyll
                       !--------------------------------------------------
-                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn )
-                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) )
-                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) )
+                      zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
                   ENDIF
                END DO
@@ -183 +185 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-
-                  ! Computation of the P-I slope for nanos and diatoms
                   IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
-                      zadap       = ztn / ( 2.+ ztn )
-                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia )
-                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp
-                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
-                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
-                      !
-                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) )
-                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn )
-
-                      zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                &
-                        &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
-                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
-
-                      zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                &
-                        &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
-                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
-
                       ! Computation of production function for Carbon
                       !  ---------------------------------------------
-                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) )
-                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) )
-
+                      zpislopen = zpislopeadn(ji,jj,jk)  / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
+                      zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
                       !  Computation of production function for Chlorophyll
                       !--------------------------------------------------
-                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
-                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
+                      zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                      zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
                   ENDIF
                END DO
@@ -218 +203 @@
          END DO
       ENDIF
-
 
       !  Computation of a proxy of the N/C ratio
@@ -261 +245 @@
       END DO
 
-      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) )
-            zmxlday = zmxltst * zmxltst * r1_rday
-            zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday )
-            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday )
-         END DO
-      END DO
- 
-      !  Mixed-layer effect on production                                                                               
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj)
-                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj)
-               ENDIF
+      !  Mixed-layer effect on production 
+      !  Sea-ice effect on production
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
                zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
                zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
@@ -290 +262 @@
             DO ji = 1, jpi
                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
-                  !  production terms for nanophyto.
-                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
-                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
+                  !  production terms for nanophyto. (C)
+                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2
+                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn )
-                  zratio = zratio / fecnm 
+                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn )
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
-                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  &
+                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
                   &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
                   &             * zmax * trb(ji,jj,jk,jpphy) * rfact2
-                  !  production terms for diatomees
+                  !  production terms for diatoms (C)
                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2
                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
                   !
-                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn )
-                  zratio = zratio / fecdm 
+                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn )
                   zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
-                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  &
+                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
                   &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
                   &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
@@ -317 +287 @@
       END DO
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
-                  zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj)
-                  zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
-               ENDIF
+      ! Computation of the chlorophyll production terms
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
                   !  production terms for nanophyto. ( chlorophyll )
-                  znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
-                  zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
-                  zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
-                  zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / &
-                                     & (  zpislopead(ji,jj,jk) * znanotot +rtrn)
-                  !  production terms for diatomees ( chlorophyll )
-                  zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
-                  zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
-                  zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
-                  zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / &
-                                     & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn )
+                  znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
+                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
+                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
+                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / &
+                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn)
+                  !  production terms for diatoms ( chlorophyll )
+                  zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
+                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
+                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
+                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.))
+                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / &
+                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn )
+                  !   Update the arrays TRA which contain the Chla sources and sinks
+                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn
+                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd
                ENDIF
             END DO
@@ -346 +318 @@
          DO jj = 1, jpj
            DO ji =1 ,jpi
-              zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk)
-              zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
-              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
-              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk)
-              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
-              tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret
-              tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret
-              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret
-              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2
-              tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2
-              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2
-              tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2
-              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk)
-              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
-                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) )
-              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk)
-              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
-              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
-              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
-                 &                                      - rno3 * ( zproreg + zproreg2 )
-          END DO
+              IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                 zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk)
+                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
+                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+                 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+                 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)
+                 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
+                 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn
+                 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn
+                 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
+                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod
+                 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
+                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) )
+                 !
+                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup
+                 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+                 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
+                 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
+                 &                                         - rno3 * ( zproreg + zproreg2 )
+              ENDIF
+           END DO
         END DO
      END DO
+     !
+     IF( ln_ligand ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+              DO ji =1 ,jpi
+                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
+                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
+                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
+                    tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
+                 ENDIF
+              END DO
+           END DO
+        END DO
+     ENDIF
 
 
     ! Total primary production per year
     IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
-         & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
+         & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 
     IF( lk_iomput ) THEN
@@ -381 +370 @@
           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
           !
-          IF( iom_use( "PPPHY" ) .OR. iom_use( "PPPHY2" ) )  THEN
-              zw3d(:,:,:) = zprorca (:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
-              CALL iom_put( "PPPHY"  , zw3d )
+          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN
+              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto
+              CALL iom_put( "PPPHYN"  , zw3d )
               !
               zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes
-              CALL iom_put( "PPPHY2"  , zw3d )
+              CALL iom_put( "PPPHYD"  , zw3d )
           ENDIF
           IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN
-              zw3d(:,:,:) = zpronew (:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
+              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto
               CALL iom_put( "PPNEWN"  , zw3d )
               !
@@ -425 +414 @@
           ENDIF
           IF( iom_use( "TPP" ) )  THEN
-              zw3d(:,:,:) = ( zprorca(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production
+              zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production
               CALL iom_put( "TPP"  , zw3d )
           ENDIF
           IF( iom_use( "TPNEW" ) )  THEN
-              zw3d(:,:,:) = ( zpronew(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production
+              zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production
               CALL iom_put( "TPNEW"  , zw3d )
           ENDIF
@@ -436 +425 @@
               CALL iom_put( "TPBFE"  , zw3d )
           ENDIF
-          IF( iom_use( "INTPPPHY" ) .OR. iom_use( "INTPPPHY2" ) ) THEN  
+          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN  
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-               zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
+               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano
              ENDDO
-             CALL iom_put( "INTPPPHY" , zw2d )
+             CALL iom_put( "INTPPPHYN" , zw2d )
              !
              zw2d(:,:) = 0.
@@ -447 +436 @@
                 zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom
              ENDDO
-             CALL iom_put( "INTPPPHY2" , zw2d )
+             CALL iom_put( "INTPPPHYD" , zw2d )
           ENDIF
           IF( iom_use( "INTPP" ) ) THEN   
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
+                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp
              ENDDO
              CALL iom_put( "INTPP" , zw2d )
@@ -459 +448 @@
              zw2d(:,:) = 0.
              DO jk = 1, jpkm1
-                zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
+                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod
              ENDDO
              CALL iom_put( "INTPNEW" , zw2d )
@@ -482 +471 @@
           CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
        ENDIF
-     ELSE
-        IF( ln_diatrc ) THEN
-           zfact = 1.e+3 * rfact2r
-           trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zfact * tmask(:,:,:)
-           trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zfact * tmask(:,:,:)
-           trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zfact * tmask(:,:,:)
-           trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zfact * tmask(:,:,:)
-           trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)
-           trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zfact * tmask(:,:,:)
-#  if ! defined key_kriest
-           trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:)
-#  endif
-        ENDIF
      ENDIF
 
@@ -503 +479 @@
      ENDIF
      !
-     CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  )
-     CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
-     CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )
+     CALL wrk_dealloc( jpi, jpj,  zmixnano, zmixdiat,    zstrn )
+     CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 
+     CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl )
+     CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd )
      !
      IF( nn_timing == 1 )  CALL timing_stop('p4z_prod')
@@ -524 +501 @@
       !!----------------------------------------------------------------------
       !
-      NAMELIST/nampisprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2,  &
+      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd,  &
          &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
       INTEGER :: ios                 ! Local integer output status for namelist read
@@ -530 +507 @@
 
       REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
-      READ  ( numnatp_ref, nampisprod, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in reference namelist', lwp )
+      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp )
 
       REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
-      READ  ( numnatp_cfg, nampisprod, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampisprod )
+      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, namp4zprod )
 
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' '
-         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod'
+         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod
+         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod
          WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip
-         WRITE(numout,*) '    P-I slope                                 pislope      =', pislope
-         WRITE(numout,*) '    Acclimation factor to low light           xadap       =', xadap
-         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret
-         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2
+         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen
+         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap
+         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn
+         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd
          IF( ln_newprod )  THEN
             WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp
             WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
          ENDIF
-         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2
+         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped
          WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm
          WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm
@@ -560 +537 @@
       !
       r1_rday   = 1._wp / rday 
-      texcret   = 1._wp - excret
-      texcret2  = 1._wp - excret2
+      texcretn  = 1._wp - excretn
+      texcretd  = 1._wp - excretd
       tpp       = 0._wp
       !
@@ -576 +553 @@
       !
    END FUNCTION p4z_prod_alloc
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_prod                    ! Empty routine
-   END SUBROUTINE p4z_prod
-#endif 
-
    !!======================================================================
 END MODULE p4zprod

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

@@ -8 +8 @@
    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_top'       and                                      TOP models
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_rem       :  Compute remineralization/dissolution of organic compounds
    !!   p4z_rem_init  :  Initialisation of parameters for remineralisation
@@ -20 +15 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zopt          !  optical model
    USE p4zche          !  chemical model
    USE p4zprod         !  Growth rate of the 2 phyto groups
-   USE p4zmeso         !  Sources and sinks of mesozooplankton
-   USE p4zint          !  interpolation and computation of various fields
    USE p4zlim
    USE prtctl_trc      !  print control for debugging
@@ -38 +30 @@
 
    !! * Shared module variables
+   REAL(wp), PUBLIC ::  xremikc    !: remineralisation rate of DOC 
+   REAL(wp), PUBLIC ::  xremikn    !: remineralisation rate of DON 
+   REAL(wp), PUBLIC ::  xremikp    !: remineralisation rate of DOP 
    REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC 
-   REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC
    REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate 
    REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC 
    REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC 
    REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica 
-
+   REAL(wp), PUBLIC ::  feratb     !: Fe/C quota in bacteria
+   REAL(wp), PUBLIC ::  xkferb     !: Half-saturation constant for bacteria Fe/C
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   -
 
    !!----------------------------------------------------------------------
@@ -68 +62 @@
       !
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zremip, zremik, zsiremin 
+      REAL(wp) ::   zremik, zremikc, zremikn, zremikp, zsiremin, zfact 
       REAL(wp) ::   zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep
-      REAL(wp) ::   zbactfer, zorem, zorem2, zofer, zolimit
-      REAL(wp) ::   zosil, ztem
-#if ! defined key_kriest
-      REAL(wp) ::   zofer2
-#endif
-      REAL(wp) ::   zonitr, zstep, zfact
+      REAL(wp) ::   zbactfer, zolimit, zonitr, zrfact2
+      REAL(wp) ::   zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zw3d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib
       !!---------------------------------------------------------------------
       !
@@ -85 +75 @@
       ! Allocate temporary workspace
       CALL wrk_alloc( jpi, jpj,      ztempbac                  )
-      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )
+      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )
 
       ! Initialisation of temprary arrys
       zdepprod(:,:,:) = 1._wp
       ztempbac(:,:)   = 0._wp
+      zfacsib(:,:,:)  = xsilab / ( 1.0 - xsilab )
+      zfacsi(:,:,:)   = xsilab
 
       ! Computation of the mean phytoplankton concentration as
@@ -112 +104 @@
       END DO
 
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! DOC ammonification. Depends on depth, phytoplankton biomass
+                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
+                  zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
+                  zremik = MAX( zremik, 2.74e-4 * xstep )
+                  ! Ammonification in oxic waters with oxygen consumption
+                  ! -----------------------------------------------------
+                  zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+                  zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
+                  ! Ammonification in suboxic waters with denitrification
+                  ! -------------------------------------------------------
+                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
+                     &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
+                  !
+                  zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
+                  denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
+                  !
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk)    &
+                  &                     + ( rdenit + 1.) * denitr(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! DOC ammonification. Depends on depth, phytoplankton biomass
+                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity. 
+                  ! -----------------------------------------------------------------
+                  zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk) 
+                  zremik = MAX( zremik, 2.74e-4 * xstep / xremikc )
+
+                  zremikc = xremikc * zremik
+                  zremikn = xremikn / xremikc
+                  zremikp = xremikp / xremikc
+
+                  ! Ammonification in oxic waters with oxygen consumption
+                  ! -----------------------------------------------------
+                  zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
+                  zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) ) 
+                  zolimi(ji,jj,jk) = zolimic
+                  zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+                  zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
+
+                  ! Ammonification in suboxic waters with denitrification
+                  ! -------------------------------------------------------
+                  zolimit = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)
+                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, zolimit )
+                  denitr(ji,jj,jk) = MAX( 0.e0, denitr(ji,jj,jk) )
+                  zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+                  zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )
+
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn
+                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut
+                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk)
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + ( rdenit + 1.) * zdenitrn )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
+
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
-               ! DOC ammonification. Depends on depth, phytoplankton biomass
-               ! and a limitation term which is supposed to be a parameterization
-               !     of the bacterial activity. 
-               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
-               zremik = MAX( zremik, 2.74e-4 * xstep )
-               ! Ammonification in oxic waters with oxygen consumption
-               ! -----------------------------------------------------
-               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
-               zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
-               ! Ammonification in suboxic waters with denitrification
-               ! -------------------------------------------------------
-               denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
-                  &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
-               !
-               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
-               denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
-               !
-            END DO
-         END DO
-      END DO
-
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
                ! NH4 nitrification to NO3. Ceased for oxygen concentrations
                ! below 2 umol/L. Inhibited at strong light 
                ! ----------------------------------------------------------
-               zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
-               denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
+               zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  &
+               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 
+               zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)
                ! Update of the tracers trends
                ! ----------------------------
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk)
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk)
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4
+               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4
                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk)
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4
             END DO
          END DO
@@ -177 +214 @@
                ! studies (especially at Papa) have shown this uptake to be significant
                ! ----------------------------------------------------------
-               zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
-                  &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    &
+               zbactfer = feratb *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
+                  &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    &
                   &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
-#if defined key_kriest
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.05
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.05
-#else
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.16
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.12
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.04
-#endif
             END DO
          END DO
@@ -198 +230 @@
        ENDIF
 
+      ! Initialization of the array which contains the labile fraction
+      ! of bSi. Set to a constant in the upper ocean
+      ! ---------------------------------------------------------------
+
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
-               ! POC disaggregation by turbulence and bacterial activity. 
-               ! --------------------------------------------------------
-               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.55 * nitrfac(ji,jj,jk) ) 
-
-               ! POC disaggregation rate is reduced in anoxic zone as shown by
-               ! sediment traps data. In oxic area, the exponent of the martin s
-               ! law is around -0.87. In anoxic zone, it is around -0.35. This
-               ! means a disaggregation constant about 0.5 the value in oxic zones
-               ! -----------------------------------------------------------------
-               zorem  = zremip * trb(ji,jj,jk,jppoc)
-               zofer  = zremip * trb(ji,jj,jk,jpsfe)
-#if ! defined key_kriest
-               zorem2 = zremip * trb(ji,jj,jk,jpgoc)
-               zofer2 = zremip * trb(ji,jj,jk,jpbfe)
-#else
-               zorem2 = zremip * trb(ji,jj,jk,jpnum)
-#endif
-
-               ! Update the appropriate tracers trends
-               ! -------------------------------------
-
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer
-#if defined key_kriest
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
-#else
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2
-#endif
-
-            END DO
-         END DO
-      END DO
-
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('rem3')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-       ENDIF
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zstep   = xstep
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
+               zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) )
+               zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) )
+               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
+               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
                ! Remineralization rate of BSi depedant on T and saturation
                ! ---------------------------------------------------------
-               zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
-               zsatur   = MAX( rtrn, zsatur )
-               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
-               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
-               znusil2  = 0.225  * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2
-
-               ! Two classes of BSi are considered : a labile fraction and 
-               ! a more refractory one. The ratio between both fractions is
-               ! constant and specified in the namelist.
-               ! ----------------------------------------------------------
-               zdep     = MAX( hmld(ji,jj), heup(ji,jj) ) 
-               zdep     = MAX( 0., gdept_n(ji,jj,jk) - zdep )
-               ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. )
-               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
-               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
+               IF ( gdept_n(ji,jj,jk) > zdep ) THEN
+                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  &
+                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
+                  zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) )
+                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    &
+                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) )
+               ENDIF
+               zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil
                zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
                !
@@ -283 +261 @@
 
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('rem4')")
+         WRITE(charout, FMT="('rem3')")
          CALL prt_ctl_trc_info(charout)
          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
        ENDIF
-
-      ! Update the arrays TRA which contain the biological sources and sinks
-      ! --------------------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)
-         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)
-         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit
-         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)
-         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut
-         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)
-         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) )
-      END DO
 
       IF( knt == nrdttrc ) THEN
@@ -316 +281 @@
           CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
        ENDIF
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('rem6')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-      ENDIF
       !
       CALL wrk_dealloc( jpi, jpj,      ztempbac                  )
-      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_rem')
@@ -343 +302 @@
       !!
       !!----------------------------------------------------------------------
-      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab
+      NAMELIST/nampisrem/ xremik, nitrif, xsirem, xsiremlab, xsilab, feratb, xkferb, & 
+         &                xremikc, xremikn, xremikp
       INTEGER :: ios                 ! Local integer output status for namelist read
 
@@ -359 +319 @@
          WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
-         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip
-         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
+         IF( ln_p4z ) THEN
+            WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
+         ELSE
+            WRITE(numout,*) '    remineralization rate of DOC              xremikc   =', xremikc
+            WRITE(numout,*) '    remineralization rate of DON              xremikn   =', xremikn
+            WRITE(numout,*) '    remineralization rate of DOP              xremikp   =', xremikp
+         ENDIF
          WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem
          WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab
          WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab
          WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif
+         WRITE(numout,*) '    Bacterial Fe/C ratio                      feratb    =', feratb
+         WRITE(numout,*) '    Half-saturation constant for bact. Fe/C   xkferb    =', xkferb
       ENDIF
       !
       denitr  (:,:,:) = 0._wp
-      denitnh4(:,:,:) = 0._wp
       !
    END SUBROUTINE p4z_rem_init
@@ -377 +343 @@
       !!                     ***  ROUTINE p4z_rem_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc )
+      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc )
       !
       IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays')
       !
    END FUNCTION p4z_rem_alloc
-
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_rem                    ! Empty routine
-   END SUBROUTINE p4z_rem
-#endif 
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
    !!----------------------------------------------------------------------
    !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
@@ -41 +37 @@
    REAL(wp), PUBLIC  :: concfediaz  !: Fe half-saturation Cste for diazotrophs 
    REAL(wp)          :: hratio      !: Fe:3He ratio assumed for vent iron supply
+   REAL(wp), PUBLIC  :: fep_rats    !: Fep/Fer ratio from sed  sources
+   REAL(wp), PUBLIC  :: fep_rath    !: Fep/Fer ratio from hydro sources
+   REAL(wp), PUBLIC  :: lgw_rath    !: Weak ligand ratio from hydro sources
+
 
    LOGICAL , PUBLIC  :: ll_sbc
@@ -70 +70 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdic, rivalk    !: river input fields
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdin, rivdip    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdon, rivdop    !: river input fields
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdoc    !: river input fields
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdsi    !: river input fields
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition 
@@ -134 +136 @@
          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
             CALL fld_read( kt, 1, sf_river )
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
-                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
-                     &              * 1.E3        / ( 12. * zcoef + rtrn )
-                  rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) &
-                     &              * 1.E3         / ( 12. * zcoef + rtrn )
-                  rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) &
-                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
-                  rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) &
-                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
-                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    &
-                     &              * 1.E3        / ( 28.1 * zcoef + rtrn )
+            IF( ln_p4z ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 12. * zcoef + rtrn )
+                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) &
+                        &              * 1.E3         / ( 12. * zcoef + rtrn )
+                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
+                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
+                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 28.1 * zcoef + rtrn )
+                  END DO
                END DO
-            END DO
+            ELSE    !  ln_p5z
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
+                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
+                        &              * 1.E3        / ( 12. * zcoef + rtrn )
+                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdoc(ji,jj) = ( sf_river(jr_doc)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1)
+                     rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) &
+                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
          ENDIF
       ENDIF
@@ -205 +229 @@
         &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
         &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    &
-        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, hratio
+        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, &
+        &                hratio, fep_rats, fep_rath, lgw_rath
       !!----------------------------------------------------------------------
       !
@@ -249 +274 @@
          WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
          WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
+         IF( ln_ligand ) THEN
+            WRITE(numout,*) '    Fep/Fer ratio from sed sources            fep_rats   = ', fep_rats
+            WRITE(numout,*) '    Fep/Fer ratio from sed hydro sources      fep_rath   = ', fep_rath
+            WRITE(numout,*) '    Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath
+         ENDIF
       END IF
 
@@ -291 +321 @@
             END DO
             CALL iom_close( numdust )
-            ztimes_dust = 1._wp / FLOAT( ntimes_dust ) 
+            ztimes_dust = 1._wp / REAL(ntimes_dust, wp) 
             sumdepsi = 0.e0
             DO jm = 1, ntimes_dust
@@ -334 +364 @@
          !
          ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) ) 
+         IF( ln_p5z )  ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) )
          !
          ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_
@@ -355 +386 @@
                END DO
                CALL iom_close( numriv )
-               ztimes_riv = 1._wp / FLOAT(ntimes_riv) 
+               ztimes_riv = 1._wp / REAL(ntimes_riv, wp) 
                DO jm = 1, ntimes_riv
                   rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 
@@ -402 +433 @@
             END DO
             CALL iom_close( numdepo )
-            ztimes_ndep = 1._wp / FLOAT( ntimes_ndep ) 
+            ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp) 
             nitdepinput = 0._wp
             DO jm = 1, ntimes_ndep
@@ -508 +539 @@
    END SUBROUTINE p4z_sbc_init
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_sbc                         ! Empty routine
-   END SUBROUTINE p4z_sbc
-#endif 
-
    !!======================================================================
 END MODULE p4zsbc

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

@@ -9 +9 @@
    !!             3.5  !  2012-07 (O. Aumont) improvment of river input of nutrients 
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   p4z_sed        :  Compute loss of organic matter in the sediments
    !!----------------------------------------------------------------------
@@ -18 +14 @@
    USE trc             !  passive tracers common variables 
    USE sms_pisces      !  PISCES Source Minus Sink variables
-   USE p4zsink         !  vertical flux of particulate matter due to sinking
-   USE p4zopt          !  optical model
    USE p4zlim          !  Co-limitations of differents nutrients
    USE p4zsbc          !  External source of nutrients 
@@ -56 +50 @@
       INTEGER, INTENT(in) ::   kt, knt ! ocean time step
       INTEGER  ::   ji, jj, jk, ikt
-#if ! defined key_sed
       REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
       REAL(wp) ::   zrivalk, zrivsil, zrivno3
-#endif
       REAL(wp) ::  zwflux, zfminus, zfplus
       REAL(wp) ::  zlim, zfact, zfactcal
       REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit
-      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
-      REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight
+      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep
+      REAL(wp) ::  zwstpoc, zwstpon, zwstpop
+      REAL(wp) ::  ztrfer, ztrpo4s, ztrdp, zwdust, zmudia, ztemp
+      REAL(wp) ::  xdiano3, xdianh4
+      REAL(wp) ::  zwssfep
       !
       CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsedcal, zsedsi, zsedc
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsfep
+
       !!---------------------------------------------------------------------
       !
@@ -78 +76 @@
       !
       ! Allocate temporary workspace
-      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
-      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
+                      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+                      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
+                      CALL wrk_alloc( jpi, jpj, zsedcal,  zsedsi, zsedc )
+                      CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer )
+      IF( ln_p5z )    CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop )
+      IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep )
+
 
       zdenit2d(:,:) = 0.e0
@@ -87 +89 @@
       zwork2  (:,:) = 0.e0
       zwork3  (:,:) = 0.e0
+      zsedsi  (:,:) = 0.e0
+      zsedcal (:,:) = 0.e0
+      zsedc   (:,:) = 0.e0
+
 
       ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
@@ -117 +123 @@
       IF( ln_dust ) THEN
          !                                              
-         CALL wrk_alloc( jpi, jpj,      zpdep, zsidep )
-         CALL wrk_alloc( jpi, jpj, jpk, zirondep      )
+         CALL wrk_alloc( jpi, jpj,      zsidep )
+         CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep      )
          !                                              ! Iron and Si deposition at the surface
          IF( ln_solub ) THEN
@@ -125 +131 @@
             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
          ENDIF
-         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 
-         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 
+         zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1 
+         zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r 
          !                                              ! Iron solubilization of particles in the water column
          !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
@@ -132 +138 @@
          DO jk = 2, jpkm1
             zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. )
+            zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023
          END DO
          !                                              ! Iron solubilization of particles in the water column
-         tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:)
          tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
+         tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep   (:,:,:)
          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 
          ! 
@@ -145 +152 @@
                 &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface
             ENDIF
-         ELSE                                    
-            IF( ln_diatrc )  &
-              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)
          ENDIF
-         CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep )
-         CALL wrk_dealloc( jpi, jpj, jpk, zirondep      )
+         CALL wrk_dealloc( jpi, jpj,      zsidep )
+         CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep      )
          !                                              
       ENDIF
@@ -169 +173 @@
             ENDDO
          ENDDO
+         IF( ln_p5z ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  DO jk = 1, nk_rnf(ji,jj)
+                     tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2
+                     tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2
+                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDIF
       ENDIF
       
@@ -181 +196 @@
       ! ------------------------------------------------------
       IF( ln_ironsed ) THEN
-         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+                         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
+         IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2
          !
          IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
@@ -190 +206 @@
       ! ------------------------------------------------------
       IF( ln_hydrofe ) THEN
-         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
+         IF( ln_ligand ) THEN
+            tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2
+            tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2
+         ENDIF
          !
          IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
@@ -196 +216 @@
       ENDIF
 
-      ! OA: Warning, the following part is necessary, especially with Kriest
-      ! to avoid CFL problems above the sediments
+      ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments
       ! --------------------------------------------------------------------
       DO jj = 1, jpj
@@ -208 +227 @@
          END DO
       END DO
-
-#if ! defined key_sed
-      ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
-      ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
-      ! -------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-           IF( tmask(ji,jj,1) == 1 ) THEN
-              ikt = mbkt(ji,jj)
-# if defined key_kriest
-              zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
-# else
-              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
-#endif
-              zflx  = LOG10( MAX( 1E-3, zflx ) )
-              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
-              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
-              zdep  = LOG10( gdepw_n(ji,jj,ikt+1) )
-              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
-              &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
-              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
-              !
-              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
-                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
-              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
-           ENDIF
-         END DO
-      END DO 
-
-      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 
-      ! First, the total loss is computed.
-      ! The factor for calcite comes from the alkalinity effect
-      ! -------------------------------------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            IF( tmask(ji,jj,1) == 1 ) THEN
-               ikt = mbkt(ji,jj) 
-# if defined key_kriest
-               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
-               zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
-# else
-               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
-               zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
-# endif
-               ! For calcite, burial efficiency is made a function of saturation
-               zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
-               zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
-               zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
-            ENDIF
-         END DO
-      END DO
-      zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday
-      zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday
-      zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday
-#endif
+      !
+      IF( ln_ligand ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = e3t_n(ji,jj,ikt) / xstep
+               zwsfep(ji,jj)  = MIN( 0.99 * zdep, wsfep(ji,jj,ikt)  )
+            END DO
+         ENDDO
+      ENDIF
+
+      IF( .NOT.lk_sed ) THEN
+         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
+         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
+         ! -------------------------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( tmask(ji,jj,1) == 1 ) THEN
+                 ikt = mbkt(ji,jj)
+                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
+                 zflx  = LOG10( MAX( 1E-3, zflx ) )
+                 zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
+                 zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
+                 zdep  = LOG10( gdepw_n(ji,jj,ikt+1) )
+                 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
+                   &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
+                 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
+                   !
+                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
+                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
+                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
+                ENDIF
+              END DO
+           END DO 
+
+           ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 
+           ! First, the total loss is computed.
+           ! The factor for calcite comes from the alkalinity effect
+           ! -------------------------------------------------------------
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 IF( tmask(ji,jj,1) == 1 ) THEN
+                    ikt = mbkt(ji,jj) 
+                    zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
+                    zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
+                    ! For calcite, burial efficiency is made a function of saturation
+                    zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
+                    zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+                    zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
+                ENDIF
+            END DO
+         END DO
+         zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday
+         zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday
+         zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday
+         !
+      ENDIF
 
       ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
       ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
       ! ------------------------------------------------------
-#if ! defined key_sed
-      zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )
-#endif
+      IF( .NOT.lk_sed )  zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )
 
       DO jj = 1, jpj
@@ -276 +295 @@
             ikt  = mbkt(ji,jj)
             zdep = xstep / e3t_n(ji,jj,ikt) 
-            zws4 = zwsbio4(ji,jj) * zdep
             zwsc = zwscal (ji,jj) * zdep
-# if defined key_kriest
-            zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
-# else
             zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
-# endif
             zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
             !
             tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
             tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
-#if ! defined key_sed
-            tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
-            zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
-            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
-            zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
-            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
-            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
-#endif
          END DO
       END DO
-
+      !
+      IF( .NOT.lk_sed ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zwsc = zwscal (ji,jj) * zdep
+               zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
+               zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
+               tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
+               !
+               zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
+               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+               zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
+               tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+               tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+               zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep
+               zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep
+            END DO
+         END DO
+      ENDIF
+      !
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -304 +331 @@
             zws4 = zwsbio4(ji,jj) * zdep
             zws3 = zwsbio3(ji,jj) * zdep
-            zrivno3 = 1. - zbureff(ji,jj)
-# if ! defined key_kriest
             tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
             tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
-# else
-            tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4 
-            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
-            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
-            zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 
-# endif
-
-#if ! defined key_sed
-            ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
-            ! in the sediments and just above the sediments. Not very clever, but simpliest option.
-            zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
-            z1pdenit = zwstpoc * zrivno3 - zpdenit
-            zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
-            zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
-            tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
-            tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
-            tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
-            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
-            tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
-            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
-            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
-            sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)
-#endif
          END DO
       END DO
+      !
+      IF( ln_ligand ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt     = mbkt(ji,jj)
+               zdep    = xstep / e3t_n(ji,jj,ikt) 
+               zwssfep = zwsfep(ji,jj) * zdep
+               tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trb(ji,jj,ikt,jpfep) * zwssfep
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( ln_p5z ) THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zws4 = zwsbio4(ji,jj) * zdep
+               zws3 = zwsbio3(ji,jj) * zdep
+               tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4
+               tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3
+               tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4
+               tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3
+            END DO
+         END DO
+      ENDIF
+
+      IF( .NOT.lk_sed ) THEN
+         ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
+         ! in the sediments and just above the sediments. Not very clever, but simpliest option.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ikt  = mbkt(ji,jj)
+               zdep = xstep / e3t_n(ji,jj,ikt) 
+               zws4 = zwsbio4(ji,jj) * zdep
+               zws3 = zwsbio3(ji,jj) * zdep
+               zrivno3 = 1. - zbureff(ji,jj)
+               zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
+               zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
+               z1pdenit = zwstpoc * zrivno3 - zpdenit
+               zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
+               zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
+               tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
+               tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
+               tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
+               tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
+               tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
+               tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
+               tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
+               sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt)
+               zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc / zdep
+               IF( ln_p5z ) THEN
+                  zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3
+                  zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3
+                  tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + (z1pdenit - zolimit - zdenitt) * zwstpon / (zwstpoc + rtrn)
+                  tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + (z1pdenit - zolimit - zdenitt) * zwstpop / (zwstpoc + rtrn)
+               ENDIF
+            END DO
+         END DO
+       ENDIF
+
 
       ! Nitrogen fixation process
@@ -341 +403 @@
       !-----------------------------------
       DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !                      ! Potential nitrogen fixation dependant on temperature and iron
-               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
-               IF( zlim <= 0.2 )   zlim = 0.01
-#if defined key_degrad
-               zfact = zlim * rfact2 * facvol(ji,jj,jk)
-#else
-               zfact = zlim * rfact2
-#endif
-               ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
-               ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
-               zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 
-               nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
-                 &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight
-               zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
-            END DO
-         END DO
-      END DO
+         zlight (:,:,jk) =  ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) ) 
+         zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) )
+      ENDDO
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                      ! Potential nitrogen fixation dependant on temperature and iron
+                  zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
+                  IF( zlim <= 0.2 )   zlim = 0.01
+                  zfact = zlim * rfact2
+
+                  ztrfer  = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
+                  ztrpo4s = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
+                  nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
+                    &                *  zfact * MIN( ztrfer, ztrpo4s ) * zlight(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSE       ! p5z
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !                      ! Potential nitrogen fixation dependant on temperature and iron
+                  ztemp = tsn(ji,jj,jk,jp_tem)
+                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625
+                  !       Potential nitrogen fixation dependant on temperature and iron
+                  xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) )
+                  xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4)
+                  zlim = ( 1.- xdiano3 - xdianh4 )
+                  IF( zlim <= 0.1 )   zlim = 0.01
+                  zfact = zlim * rfact2
+                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
+                  ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) )
+                  ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk))
+                  ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk)
+                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
 
       ! Nitrogen change due to nitrogen fixation
       ! ----------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zfact = nitrpot(ji,jj,jk) * nitrfix
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
-               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
-               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
-               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
-               &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
-               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
-           END DO
-         END DO 
-      END DO
+      IF( ln_p4z ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfact = nitrpot(ji,jj,jk) * nitrfix
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
+                  &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
+              END DO
+            END DO 
+         END DO
+      ELSE    ! p5z
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfact = nitrpot(ji,jj,jk) * nitrfix
+                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0
+                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0
+                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) &
+                  &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0
+                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  &
+                  &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   &
+                  &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn)
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0
+                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0
+                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0
+                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0
+                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0
+                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0
+                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0 
+                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0
+                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0
+                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday
+              END DO
+            END DO 
+         END DO
+         !
+      ENDIF
 
       IF( lk_iomput ) THEN
@@ -388 +503 @@
                CALL iom_put( "INTNFIX" , zwork1 ) 
             ENDIF
+            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 )
+            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * 1.e+3 )
+            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * 1.e+3 )
+            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 )
          ENDIF
-      ELSE
-         IF( ln_diatrc )  &
-            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1)
       ENDIF
       !
@@ -400 +516 @@
       ENDIF
       !
-      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
-      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
-      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
+                      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
+                      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
+                      CALL wrk_dealloc( jpi, jpj, zsedcal,  zsedsi, zsedc )
+                      CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer )
+      IF( ln_p5z )    CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop )
+      IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep )
       !
       IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
-      !
- 9100  FORMAT(i8,3f10.5)
       !
    END SUBROUTINE p4z_sed
@@ -422 +539 @@
 
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_sed                         ! Empty routine
-   END SUBROUTINE p4z_sed
-#endif 
-
    !!======================================================================
 END MODULE p4zsed

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

@@ -9 +9 @@
    !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting
    !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
    !!   p4z_sink       :  Compute vertical flux of particulate matter due to gravitational sinking
    !!   p4z_sink_init  :  Unitialisation of sinking speed parameters
@@ -29 +27 @@
    PUBLIC   p4z_sink_alloc
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds
-
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes 
    !                                                          !  (different meanings depending on the parameterization)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingn, sinking2n  !: POC sinking fluxes 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingp, sinking2p  !: POC sinking fluxes 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes
-#if ! defined key_kriest
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes
-#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfep      !: Fep sinking fluxes
 
    INTEGER  :: ik100
-
-#if  defined key_kriest
-   REAL(wp) ::  xkr_sfact    !: Sinking factor
-   REAL(wp) ::  xkr_stick    !: Stickiness
-   REAL(wp) ::  xkr_nnano    !: Nbr of cell in nano size class
-   REAL(wp) ::  xkr_ndiat    !: Nbr of cell in diatoms size class
-   REAL(wp) ::  xkr_nmicro   !: Nbr of cell in microzoo size class
-   REAL(wp) ::  xkr_nmeso    !: Nbr of cell in mesozoo  size class
-   REAL(wp) ::  xkr_naggr    !: Nbr of cell in aggregates  size class
-
-   REAL(wp) ::  xkr_frac 
-
-   REAL(wp), PUBLIC ::  xkr_dnano       !: Size of particles in nano pool
-   REAL(wp), PUBLIC ::  xkr_ddiat       !: Size of particles in diatoms pool
-   REAL(wp), PUBLIC ::  xkr_dmicro      !: Size of particles in microzoo pool
-   REAL(wp), PUBLIC ::  xkr_dmeso       !: Size of particles in mesozoo pool
-   REAL(wp), PUBLIC ::  xkr_daggr       !: Size of particles in aggregates pool
-   REAL(wp), PUBLIC ::  xkr_wsbio_min   !: min vertical particle speed
-   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates
-#endif
 
    !!----------------------------------------------------------------------
@@ -72 +45 @@
 CONTAINS
 
-#if ! defined key_kriest
    !!----------------------------------------------------------------------
    !!   'standard sinking parameterisation'                  ???
@@ -91 +63 @@
       REAL(wp) ::   zagg1, zagg2, zagg3, zagg4
       REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
-      REAL(wp) ::   zfact, zwsmax, zmax, zstep
+      REAL(wp) ::   zfact, zwsmax, zmax
       CHARACTER (len=25) :: charout
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d
@@ -98 +70 @@
       !
       IF( nn_timing == 1 )  CALL timing_start('p4z_sink')
+
+
+      ! Initialization of some global variables
+      ! ---------------------------------------
+      prodpoc(:,:,:) = 0.
+      conspoc(:,:,:) = 0.
+      prodgoc(:,:,:) = 0.
+      consgoc(:,:,:) = 0.
+
       !
       !    Sinking speeds of detritus is increased with depth as shown
@@ -105 +86 @@
          DO jj = 1, jpj
             DO ji = 1,jpi
-               zmax  = MAX( heup(ji,jj), hmld(ji,jj) )
-               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp
-               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact
+               zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) )
+               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale
+               wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact
             END DO
          END DO
@@ -114 +95 @@
       ! limit the values of the sinking speeds to avoid numerical instabilities  
       wsbio3(:,:,:) = wsbio
-      wscal (:,:,:) = wsbio4(:,:,:)
+
       !
       ! OA This is (I hope) a temporary solution for the problem that may 
@@ -155 +136 @@
                IF( tmask(ji,jj,jk) == 1 ) THEN
                  zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep
-                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) )
-                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) )
+                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * REAL( iiter1, wp ) )
+                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * REAL( iiter2, wp ) )
                ENDIF
             END DO
          END DO
       END DO
+
+      wscal (:,:,:) = wsbio4(:,:,:)
 
       !  Initializa to zero all the sinking arrays 
@@ -185 +168 @@
       END DO
 
-      !  Exchange between organic matter compartments due to coagulation/disaggregation
-      !  ---------------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               zstep = xstep 
-# if defined key_degrad
-               zstep = zstep * facvol(ji,jj,jk)
-# endif
-               zfact = zstep * xdiss(ji,jj,jk)
-               !  Part I : Coagulation dependent on turbulence
-               zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
-               zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
-
-               ! Part II : Differential settling
-
-               !  Aggregation of small into large particles
-               zagg3 =  47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
-               zagg4 =  3.3  * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
-
-               zagg   = zagg1 + zagg2 + zagg3 + zagg4
-               zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
-
-               ! Aggregation of DOC to POC : 
-               ! 1st term is shear aggregation of DOC-DOC
-               ! 2nd term is shear aggregation of DOC-POC
-               ! 3rd term is differential settling of DOC-POC
-               zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
-               &            + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
-               ! transfer of DOC to GOC : 
-               ! 1st term is shear aggregation
-               ! 2nd term is differential settling 
-               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
-               ! tranfer of DOC to POC due to brownian motion
-               zaggdoc3 =  ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc)
-
-               !  Update the trends
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
-               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
-               !
-            END DO
-         END DO
-      END DO
-
+      IF( ln_p5z ) THEN
+         sinkingn (:,:,:) = 0.e0
+         sinking2n(:,:,:) = 0.e0
+         sinkingp (:,:,:) = 0.e0
+         sinking2p(:,:,:) = 0.e0
+
+         !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+         !   -----------------------------------------------------
+         DO jit = 1, iiter1
+           CALL p4z_sink2( wsbio3, sinkingn , jppon, iiter1 )
+           CALL p4z_sink2( wsbio3, sinkingp , jppop, iiter1 )
+         END DO
+
+         DO jit = 1, iiter2
+           CALL p4z_sink2( wsbio4, sinking2n, jpgon, iiter2 )
+           CALL p4z_sink2( wsbio4, sinking2p, jpgop, iiter2 )
+         END DO
+      ENDIF
+
+      IF( ln_ligand ) THEN
+         wsfep (:,:,:) = wfep
+         DO jk = 1,jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( tmask(ji,jj,jk) == 1 ) THEN
+                    zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep
+                    wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * REAL( iiter1, wp ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+         sinkfep(:,:,:) = 0.e0
+         DO jit = 1, iiter1
+           CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 )
+         END DO
+      ENDIF
 
      ! Total carbon export per year
@@ -281 +253 @@
           CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
         ENDIF
-      ELSE
-         IF( ln_diatrc ) THEN
-            zfact = 1.e3 * rfact2r
-            trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1)
-            trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1)
-            trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1)
-            trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik100) * zfact * tmask(:,:,1)
-            trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik100) * zfact * tmask(:,:,1)
-            trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1)
-         ENDIF
       ENDIF
       !
@@ -320 +282 @@
       !
    END SUBROUTINE p4z_sink_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   'Kriest sinking parameterisation'        key_kriest          ???
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE p4z_sink ( kt, knt )
-      !!---------------------------------------------------------------------
-      !!                ***  ROUTINE p4z_sink  ***
-      !!
-      !! ** Purpose :   Compute vertical flux of particulate matter due to
-      !!              gravitational sinking - Kriest parameterization
-      !!
-      !! ** Method  : - ???
-      !!---------------------------------------------------------------------
-      !
-      INTEGER, INTENT(in) :: kt, knt
-      !
-      INTEGER  :: ji, jj, jk, jit, niter1, niter2
-      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zfract, zaggsi, zaggsh
-      REAL(wp) :: zagg , zaggdoc, zaggdoc1, znumdoc
-      REAL(wp) :: znum , zeps, zfm, zgm, zsm
-      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5
-      REAL(wp) :: zval1, zval2, zval3, zval4
-      REAL(wp) :: zfact
-      INTEGER  :: ik1
-      CHARACTER (len=25) :: charout
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d 
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
-      !!---------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('p4z_sink')
-      !
-      CALL wrk_alloc( jpi, jpj, jpk, znum3d )
-      !
-      !     Initialisation of variables used to compute Sinking Speed
-      !     ---------------------------------------------------------
-
-      znum3d(:,:,:) = 0.e0
-      zval1 = 1. + xkr_zeta
-      zval2 = 1. + xkr_zeta + xkr_eta
-      zval3 = 1. + xkr_eta
-
-      !     Computation of the vertical sinking speed : Kriest et Evans, 2000
-      !     -----------------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
-                  znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
-                  ! -------------- To avoid sinking speed over 50 m/day -------
-                  znum  = MIN( xnumm(jk), znum )
-                  znum  = MAX( 1.1      , znum )
-                  znum3d(ji,jj,jk) = znum
-                  !------------------------------------------------------------
-                  zeps  = ( zval1 * znum - 1. )/ ( znum - 1. )
-                  zfm   = xkr_frac**( 1. - zeps )
-                  zgm   = xkr_frac**( zval1 - zeps )
-                  zdiv  = MAX( 1.e-4, ABS( zeps - zval2 ) ) * SIGN( 1., ( zeps - zval2 ) )
-                  zdiv1 = zeps - zval3
-                  wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    &
-                     &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv
-                  wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   &
-                     &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1
-                  IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk)
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      wscal(:,:,:) = MAX( wsbio3(:,:,:), 30._wp )
-
-      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS
-      !   -----------------------------------------
-
-      sinking (:,:,:) = 0.e0
-      sinking2(:,:,:) = 0.e0
-      sinkcal (:,:,:) = 0.e0
-      sinkfer (:,:,:) = 0.e0
-      sinksil (:,:,:) = 0.e0
-
-     !   Compute the sedimentation term using p4zsink2 for all the sinking particles
-     !   -----------------------------------------------------
-
-      niter1 = niter1max
-      niter2 = niter2max
-
-      DO jit = 1, niter1
-        CALL p4z_sink2( wsbio3, sinking , jppoc, niter1 )
-        CALL p4z_sink2( wsbio3, sinkfer , jpsfe, niter1 )
-        CALL p4z_sink2( wscal , sinksil , jpgsi, niter1 )
-        CALL p4z_sink2( wscal , sinkcal , jpcal, niter1 )
-      END DO
-
-      DO jit = 1, niter2
-        CALL p4z_sink2( wsbio4, sinking2, jpnum, niter2 )
-      END DO
-
-     !  Exchange between organic matter compartments due to coagulation/disaggregation
-     !  ---------------------------------------------------
-
-      zval1 = 1. + xkr_zeta
-      zval2 = 1. + xkr_eta
-      zval3 = 3. + xkr_eta
-      zval4 = 4. + xkr_eta
-
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
-
-                  znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp
-                  !-------------- To avoid sinking speed over 50 m/day -------
-                  znum  = min(xnumm(jk),znum)
-                  znum  = MAX( 1.1,znum)
-                  !------------------------------------------------------------
-                  zeps  = ( zval1 * znum - 1.) / ( znum - 1.)
-                  zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 )
-                  zdiv1 = MAX( 1.e-4, ABS( zeps - 4.   ) ) * SIGN( 1., zeps - 4.    )
-                  zdiv2 = zeps - 2.
-                  zdiv3 = zeps - 3.
-                  zdiv4 = zeps - zval2
-                  zdiv5 = 2.* zeps - zval4
-                  zfm   = xkr_frac**( 1.- zeps )
-                  zsm   = xkr_frac**xkr_eta
-
-                  !    Part I : Coagulation dependant on turbulence
-                  !    ----------------------------------------------
-
-                  zagg1 =  0.163 * trb(ji,jj,jk,jpnum)**2               &
-                     &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    &
-                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    &
-                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  &
-                     &            * (zeps-1.)**2/(zdiv2*zdiv3)) 
-                  zagg2 =  2*0.163*trb(ji,jj,jk,jpnum)**2*zfm*                       &
-                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          &
-                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 &
-                     &                    +xkr_mass_max*xkr_mass_min**2*(zeps-1.)/zdiv3)    &
-                     &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  &
-                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           &
-                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))    
-
-                  zagg3 =  0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
-                  
-                 !    Aggregation of small into large particles
-                 !    Part II : Differential settling
-                 !    ----------------------------------------------
-
-                  zagg4 =  2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2*                       &
-                     &                 xkr_wsbio_min*(zeps-1.)**2                         &
-                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      &
-                     &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       &
-                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     &
-                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )   
-
-                  zagg5 =   2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2                         &
-                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        &
-                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         &
-                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    &
-                     &                 /zdiv)  
-
-                  !
-                  !     Fractionnation by swimming organisms
-                  !     ------------------------------------
-
-                  zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum)  &
-                    &      * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2  &
-                    &      * 10000.*xstep
-
-                  !     Aggregation of DOC to small particles
-                  !     --------------------------------------
-
-                  zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)   &
-                     &        + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc)
-                  zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  &
-                     &  + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc)
-
-# if defined key_degrad
-                   zagg1   = zagg1   * facvol(ji,jj,jk)                 
-                   zagg2   = zagg2   * facvol(ji,jj,jk)                 
-                   zagg3   = zagg3   * facvol(ji,jj,jk)                 
-                   zagg4   = zagg4   * facvol(ji,jj,jk)                 
-                   zagg5   = zagg5   * facvol(ji,jj,jk)                 
-                   zaggdoc = zaggdoc * facvol(ji,jj,jk)                 
-                   zaggdoc1 = zaggdoc1 * facvol(ji,jj,jk)
-# endif
-                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000.
-                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10.
-                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
-                  !
-                  znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn )
-                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1
-                  tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg
-                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc1
-
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-     ! Total primary production per year
-     t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:,ik100) * e1e2t(:,:) * tmask(:,:,1) )
-     !
-     IF( lk_iomput ) THEN
-        IF( knt == nrdttrc ) THEN
-          CALL wrk_alloc( jpi, jpj,      zw2d )
-          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
-          !
-          IF( iom_use( "EPC100" ) )  THEN
-              zw2d(:,:) = sinking(:,:,ik100) * zfact * tmask(:,:,1) ! Export of carbon at 100m
-              CALL iom_put( "EPC100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPN100" ) )  THEN
-              zw2d(:,:) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) ! Export of number of aggregates ?
-              CALL iom_put( "EPN100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPCAL100" ) )  THEN
-              zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m
-              CALL iom_put( "EPCAL100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EPSI100" ) )  THEN
-              zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m
-              CALL iom_put( "EPSI100"  , zw2d )
-          ENDIF
-          IF( iom_use( "EXPC" ) )  THEN
-              zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column
-              CALL iom_put( "EXPC"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPN" ) )  THEN
-              zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column
-              CALL iom_put( "EXPN"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPCAL" ) )  THEN
-              zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite 
-              CALL iom_put( "EXPCAL"  , zw3d )
-          ENDIF
-          IF( iom_use( "EXPSI" ) )  THEN
-              zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica
-              CALL iom_put( "EXPSI"  , zw3d )
-          ENDIF
-          IF( iom_use( "XNUM" ) )  THEN
-              zw3d(:,:,:) =  znum3d(:,:,:) * tmask(:,:,:) !  Number of particles on aggregats
-              CALL iom_put( "XNUM"  , zw3d )
-          ENDIF
-          IF( iom_use( "WSC" ) )  THEN
-              zw3d(:,:,:) = wsbio3(:,:,:) * tmask(:,:,:) ! Sinking speed of carbon particles
-              CALL iom_put( "WSC"  , zw3d )
-          ENDIF
-          IF( iom_use( "WSN" ) )  THEN
-              zw3d(:,:,:) = wsbio4(:,:,:) * tmask(:,:,:) ! Sinking speed of particles number
-              CALL iom_put( "WSN"  , zw3d )
-          ENDIF
-          !
-          CALL wrk_dealloc( jpi, jpj,      zw2d )
-          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
-      ELSE
-         IF( ln_diatrc ) THEN
-            zfact = 1.e3 * rfact2r
-            trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik100)  * zfact * tmask(:,:,1)
-            trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik100)  * zfact * tmask(:,:,1)
-            trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik100)  * zfact * tmask(:,:,1)
-            trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik100)  * zfact * tmask(:,:,1)
-            trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik100)  * zfact * tmask(:,:,1)
-            trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zfact * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zfact * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zfact * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zfact * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)              * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)              * tmask(:,:,:)
-            trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)              * tmask(:,:,:)
-         ENDIF
-      ENDIF
-
-      !
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('sink')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-      ENDIF
-      !
-      CALL wrk_dealloc( jpi, jpj, jpk, znum3d )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink')
-      !
-   END SUBROUTINE p4z_sink
-
-
-   SUBROUTINE p4z_sink_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE p4z_sink_init  ***
-      !!
-      !! ** Purpose :   Initialization of sinking parameters
-      !!                Kriest parameterization only
-      !!
-      !! ** Method  :   Read the nampiskrs namelist and check the parameters
-      !!      called at the first timestep 
-      !!
-      !! ** input   :   Namelist nampiskrs
-      !!----------------------------------------------------------------------
-      INTEGER  ::   jk, jn, kiter
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
-      REAL(wp) ::   znum, zdiv
-      REAL(wp) ::   zws, zwr, zwl,wmax, znummax
-      REAL(wp) ::   zmin, zmax, zl, zr, xacc
-      !
-      NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  &
-         &                xkr_nnano, xkr_ndiat, xkr_nmicro, xkr_nmeso, xkr_naggr
-      !!----------------------------------------------------------------------
-      !
-      IF( nn_timing == 1 )  CALL timing_start('p4z_sink_init')
-      !
-
-      REWIND( numnatp_ref )              ! Namelist nampiskrs in reference namelist : Pisces sinking Kriest
-      READ  ( numnatp_ref, nampiskrs, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in reference namelist', lwp )
-
-      REWIND( numnatp_cfg )              ! Namelist nampiskrs in configuration namelist : Pisces sinking Kriest
-      READ  ( numnatp_cfg, nampiskrs, IOSTAT = ios, ERR = 902 )
-902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampiskrs )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : nampiskrs'
-         WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact
-         WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick
-         WRITE(numout,*) '    Nbr of cell in nano size class           xkr_nnano    = ', xkr_nnano
-         WRITE(numout,*) '    Nbr of cell in diatoms size class        xkr_ndiat    = ', xkr_ndiat
-         WRITE(numout,*) '    Nbr of cell in microzoo size class       xkr_nmicro   = ', xkr_nmicro
-         WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso
-         WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr
-      ENDIF
-
-
-      ! max and min vertical particle speed
-      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta
-      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta
-      IF (lwp) WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max
-
-      !
-      !    effect of the sizes of the different living pools on particle numbers
-      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337
-      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718
-      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147
-      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877
-      !    doc aggregates = 1um
-      ! ----------------------------------------------------------
-
-      xkr_dnano = 1. / ( xkr_massp * xkr_nnano )
-      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat )
-      xkr_dmicro = 1. / ( xkr_massp * xkr_nmicro )
-      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso )
-      xkr_daggr = 1. / ( xkr_massp * xkr_naggr )
-
-      !!---------------------------------------------------------------------
-      !!    'key_kriest'                                                  ???
-      !!---------------------------------------------------------------------
-      !  COMPUTATION OF THE VERTICAL PROFILE OF MAXIMUM SINKING SPEED
-      !  Search of the maximum number of particles in aggregates for each k-level.
-      !  Bissection Method
-      !--------------------------------------------------------------------
-      IF (lwp) THEN
-        WRITE(numout,*)
-        WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates'
-      ENDIF
-
-      xacc     =  0.001_wp
-      kiter    = 50
-      zmin     =  1.10_wp
-      zmax     = xkr_mass_max / xkr_mass_min
-      xkr_frac = zmax
-
-      DO jk = 1,jpk
-         zl = zmin
-         zr = zmax
-         wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2
-         zdiv = xkr_zeta + xkr_eta - xkr_eta * zl
-         znum = zl - 1.
-         zwl =  xkr_wsbio_min * xkr_zeta / zdiv &
-            & - ( xkr_wsbio_max * xkr_eta * znum * &
-            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
-            & - wmax
-
-         zdiv = xkr_zeta + xkr_eta - xkr_eta * zr
-         znum = zr - 1.
-         zwr =  xkr_wsbio_min * xkr_zeta / zdiv &
-            & - ( xkr_wsbio_max * xkr_eta * znum * &
-            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
-            & - wmax
-iflag:   DO jn = 1, kiter
-            IF    ( zwl == 0._wp ) THEN   ;   znummax = zl
-            ELSEIF( zwr == 0._wp ) THEN   ;   znummax = zr
-            ELSE
-               znummax = ( zr + zl ) / 2.
-               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax
-               znum = znummax - 1.
-               zws =  xkr_wsbio_min * xkr_zeta / zdiv &
-                  & - ( xkr_wsbio_max * xkr_eta * znum * &
-                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
-                  & - wmax
-               IF( zws * zwl < 0. ) THEN   ;   zr = znummax
-               ELSE                        ;   zl = znummax
-               ENDIF
-               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl
-               znum = zl - 1.
-               zwl =  xkr_wsbio_min * xkr_zeta / zdiv &
-                  & - ( xkr_wsbio_max * xkr_eta * znum * &
-                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
-                  & - wmax
-
-               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr
-               znum = zr - 1.
-               zwr =  xkr_wsbio_min * xkr_zeta / zdiv &
-                  & - ( xkr_wsbio_max * xkr_eta * znum * &
-                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
-                  & - wmax
-               !
-               IF ( ABS ( zws )  <= xacc ) EXIT iflag
-               !
-            ENDIF
-            !
-         END DO iflag
-
-         xnumm(jk) = znummax
-         IF (lwp) WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk)
-         !
-      END DO
-      !
-      ik100 = 10        !  last level where depth less than 100 m
-      DO jk = jpkm1, 1, -1
-         IF( gdept_1d(jk) > 100. )  iksed = jk - 1
-      END DO
-      IF (lwp) WRITE(numout,*)
-      IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ',  ik100 + 1
-      IF (lwp) WRITE(numout,*)
-      !
-      t_oce_co2_exp = 0._wp
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink_init')
-      !
-  END SUBROUTINE p4z_sink_init
-
-#endif
 
    SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra, kiter )
@@ -794 +310 @@
       CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb )
 
-      zstep = rfact2 / FLOAT( kiter ) / 2.
+      zstep = rfact2 / REAL( kiter, wp ) / 2.
 
       ztraz(:,:,:) = 0.e0
@@ -804 +320 @@
       END DO
       zwsink2(:,:,1) = 0.e0
-      IF( lk_degrad ) THEN
-         zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:)
-      ENDIF
 
 
@@ -887 +400 @@
       !!                     ***  ROUTINE p4z_sink_alloc  ***
       !!----------------------------------------------------------------------
-      ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4  (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) ,     &
-         &      sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                      ,     &                
-         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                      ,     &                
-#if defined key_kriest
-         &      xnumm(jpk)                                                        ,     &                
-#else
-         &      sinkfer2(jpi,jpj,jpk)                                             ,     &                
-#endif
-         &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                
+      INTEGER :: ierr(3)
+
+      ierr(:) = 0
+      !
+      ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                    ,     &                
+         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                    ,     &                
+         &      sinkfer2(jpi,jpj,jpk)                                           ,     &                
+         &      sinkfer(jpi,jpj,jpk)                                            , STAT=ierr(1) )                
          !
+      IF( ln_ligand ) ALLOCATE( sinkfep(jpi,jpj,jpk)                            , STAT=ierr(2) )  
+         
+      IF( ln_p5z    ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk)   ,     &
+         &                      sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk)   , STAT=ierr(3) )
+      !
+      p4z_sink_alloc = MAXVAL( ierr )
       IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.')
       !
    END FUNCTION p4z_sink_alloc
    
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_sink                    ! Empty routine
-   END SUBROUTINE p4z_sink
-#endif 
-
    !!======================================================================
 END MODULE p4zsink

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

@@ -6 +6 @@
    !! History :   1.0  !  2004-03 (O. Aumont) Original code
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
    !!----------------------------------------------------------------------
    !!   p4zsms         :  Time loop of passive tracers sms
@@ -69 +65 @@
       INTEGER ::   ji, jj, jk, jnt, jn, jl
       REAL(wp) ::  ztra
-#if defined key_kriest
-      REAL(wp) ::  zcoef1, zcoef2
-#endif
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
@@ -83 +76 @@
         CALL p4z_che                              ! initialize the chemical constants
         !
-        IF( .NOT. ln_rsttr ) THEN  ;   CALL p4z_ph_ini   !  set PH at kt=nit000 
+        IF( .NOT. ln_rsttr ) THEN  ;   CALL ahini_for_at(hi)   !  set PH at kt=nit000 
         ELSE                       ;   CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields 
         ENDIF
@@ -91 +84 @@
       IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
       !
-      !                                                                    !   set time step size (Euler/Leapfrog)
-      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc     !  at nittrc000
-      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
-      ENDIF
+      rfact = r2dttrc
       !
       IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
          rfactr  = 1. / rfact
-         rfact2  = rfact / FLOAT( nrdttrc )
+         rfact2  = rfact / REAL( nrdttrc, wp )
          rfact2r = 1. / rfact2
          xstep = rfact2 / rday         ! Time step duration for biology
@@ -165 +155 @@
       END DO
 
-#if defined key_kriest
-      ! 
-      zcoef1 = 1.e0 / xkr_massp 
-      zcoef2 = 1.e0 / xkr_massp / 1.1
-      DO jk = 1,jpkm1
-         trb(:,:,jk,jpnum) = MAX(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
-         trb(:,:,jk,jpnum) = MIN(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2              )
-      END DO
-      !
-#endif
-      !
       !
       IF( l_trdtrc ) THEN
@@ -212 +191 @@
       !! ** input   :   file 'namelist.trc.s' containing the following
       !!             namelist: natext, natbio, natsms
-      !!                       natkriest ("key_kriest")
-      !!----------------------------------------------------------------------
-      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max
-#if defined key_kriest
-      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max
-#endif
+      !!----------------------------------------------------------------------
+      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale,    &
+         &                   niter1max, niter2max, wfep, ldocp, ldocz, lthet,  &
+         &                   no3rat3, po4rat3
+
       NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
       NAMELIST/nampismass/ ln_check_mass
@@ -234 +212 @@
       IF(lwp) THEN                         ! control print
          WRITE(numout,*) ' Namelist : nampisbio'
-         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc
-         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio
-         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort
-         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
-         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
+         WRITE(numout,*) '    frequence pour la biologie                nrdttrc    =', nrdttrc
+         WRITE(numout,*) '    POC sinking speed                         wsbio      =', wsbio
+         WRITE(numout,*) '    half saturation constant for mortality    xkmort     =', xkmort 
+         IF( ln_p5z ) THEN
+            WRITE(numout,*) '    N/C in zooplankton                        no3rat3    =', no3rat3
+            WRITE(numout,*) '    P/C in zooplankton                        po4rat3    =', po4rat3
+         ENDIF
+         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3     =', ferat3
+         WRITE(numout,*) '    Big particles sinking speed               wsbio2     =', wsbio2
+         WRITE(numout,*) '    Big particles maximum sinking speed       wsbio2max  =', wsbio2max
+         WRITE(numout,*) '    Big particles sinking speed length scale  wsbio2scale =', wsbio2scale
          WRITE(numout,*) '    Maximum number of iterations for POC      niter1max =', niter1max
          WRITE(numout,*) '    Maximum number of iterations for GOC      niter2max =', niter2max
-      ENDIF
-
-#if defined key_kriest
-
-      !                               ! nampiskrp : kriest parameters
-      !                               ! -----------------------------
-      REWIND( numnatp_ref )              ! Namelist nampiskrp in reference namelist : Pisces Kriest
-      READ  ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903)
-903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp )
-
-      REWIND( numnatp_cfg )              ! Namelist nampiskrp in configuration namelist : Pisces Kriest
-      READ  ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 )
-904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp )
-      IF(lwm) WRITE ( numonp, nampiskrp )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : nampiskrp'
-         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta
-         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
-         WRITE(numout,*) '    N content factor                         xkr_ncontent = ', xkr_ncontent
-         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
-         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
-         WRITE(numout,*)
-     ENDIF
-
-
-     ! Computation of some variables
-     xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta
-
-#endif
+         IF( ln_ligand ) THEN
+            WRITE(numout,*) '    FeP sinking speed                             wfep   =', wfep
+            IF( ln_p4z ) THEN
+              WRITE(numout,*) '    Phyto ligand production per unit doc          ldocp  =', ldocp
+              WRITE(numout,*) '    Zoo ligand production per unit doc            ldocz  =', ldocz
+              WRITE(numout,*) '    Proportional loss of ligands due to Fe uptake lthet  =', lthet
+            ENDIF
+         ENDIF
+      ENDIF
+
 
       REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping
@@ -308 +271 @@
    END SUBROUTINE p4z_sms_init
 
-   SUBROUTINE p4z_ph_ini
-      !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE p4z_ini_ph  ***
-      !!
-      !!  ** Purpose : Initialization of chemical variables of the carbon cycle
-      !!---------------------------------------------------------------------
-      INTEGER  ::  ji, jj, jk
-      REAL(wp) ::  zcaralk, zbicarb, zco3
-      REAL(wp) ::  ztmas, ztmas1
-      !!---------------------------------------------------------------------
-
-      ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???)
-      ! --------------------------------------------------------
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztmas   = tmask(ji,jj,jk)
-               ztmas1  = 1. - tmask(ji,jj,jk)
-               zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
-               zco3    = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
-               zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )
-               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
-            END DO
-         END DO
-     END DO
-     !
-   END SUBROUTINE p4z_ph_ini
-
    SUBROUTINE p4z_rst( kt, cdrw )
       !!---------------------------------------------------------------------
@@ -349 +284 @@
       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
       !
-      INTEGER  ::  ji, jj, jk
-      REAL(wp) ::  zcaralk, zbicarb, zco3
-      REAL(wp) ::  ztmas, ztmas1
       !!---------------------------------------------------------------------
 
@@ -363 +295 @@
             CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  )
          ELSE
-!            hi(:,:,:) = 1.e-9 
-            CALL p4z_ph_ini
+            CALL ahini_for_at(hi)
          ENDIF
          CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
@@ -379 +310 @@
          ENDIF
          !
+         IF( ln_p5z ) THEN
+            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
+               CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:)  )
+               CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:)  )
+               CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  )
+            ELSE
+               sizep(:,:,:) = 1.
+               sizen(:,:,:) = 1.
+               sized(:,:,:) = 1.
+            ENDIF
+        ENDIF
+        !
       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
          IF( kt == nitrst ) THEN
@@ -389 +332 @@
          CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
          CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
+         IF( ln_p5z ) THEN
+            CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) )
+            CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) )
+         ENDIF
       ENDIF
       !
@@ -475 +423 @@
       REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
       CHARACTER(LEN=100)   ::   cltxt
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
       INTEGER :: jk
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork
       !!----------------------------------------------------------------------
 
@@ -496 +444 @@
       ENDIF
 
+      CALL wrk_alloc( jpi, jpj, jpk, zwork )
       !
       IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
          !   Compute the budget of NO3, ALK, Si, Fer
-         no3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  &
-            &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
-            &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
-            &                    + trn(:,:,:,jppoc)                     &
-#if ! defined key_kriest
-            &                    + trn(:,:,:,jpgoc)                     &
-#endif
-            &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )
-         !
-         no3budget = no3budget / areatot
-         CALL iom_put( "pno3tot", no3budget )
+         IF( ln_p4z ) THEN
+            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      &
+               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
+               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
+               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+        ELSE
+            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   &
+               &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      & 
+               &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   &
+               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 
+        ENDIF
+        !
+        no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+        no3budget = no3budget / areatot
+        CALL iom_put( "pno3tot", no3budget )
       ENDIF
       !
       IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         po4budget = glob_sum( (   trn(:,:,:,jppo4)                     &
-            &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
-            &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
-            &                    + trn(:,:,:,jppoc)                     &
-#if ! defined key_kriest
-            &                    + trn(:,:,:,jpgoc)                     &
-#endif
-            &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )
-         po4budget = po4budget / areatot
-         CALL iom_put( "ppo4tot", po4budget )
+         IF( ln_p4z ) THEN
+            zwork(:,:,:) =    trn(:,:,:,jppo4)                                         &
+               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
+               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &        
+               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
+        ELSE
+            zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      &
+               &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      & 
+               &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   &
+               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 
+        ENDIF
+        !
+        po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
+        po4budget = po4budget / areatot
+        CALL iom_put( "ppo4tot", po4budget )
       ENDIF
       !
       IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         silbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  &
-            &                    + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  )
-         !
+         zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 
+         !
+         silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
          silbudget = silbudget / areatot
          CALL iom_put( "psiltot", silbudget )
@@ -534 +492 @@
       !
       IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         alkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              &
-            &                    + trn(:,:,:,jptal)                     &
-            &                    + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  )
-         !
+         zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.              
+         !
+         alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )         !
          alkbudget = alkbudget / areatot
          CALL iom_put( "palktot", alkbudget )
@@ -543 +500 @@
       !
       IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
-         ferbudget = glob_sum( (   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe)  &
-            &                    + trn(:,:,:,jpdfe)                     &
-#if ! defined key_kriest
-            &                    + trn(:,:,:,jpbfe)                     &
-#endif
-            &                    + trn(:,:,:,jpsfe)                     &
-            &                    + trn(:,:,:,jpzoo) * ferat3            &
-            &                    + trn(:,:,:,jpmes) * ferat3            ) * cvol(:,:,:)  )
-         !
+         zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   &
+            &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      &
+            &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3    
+         IF( ln_ligand)  zwork(:,:,:) = zwork(:,:,:) + trn(:,:,:,jpfep)                
+         !
+         ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )  
          ferbudget = ferbudget / areatot
          CALL iom_put( "pfertot", ferbudget )
       ENDIF
       !
-
+      CALL wrk_dealloc( jpi, jpj, jpk, zwork )
+      !
       ! Global budget of N SMS : denitrification in the water column and in the sediment
       !                          nitrogen fixation by the diazotrophs
@@ -600 +555 @@
    END SUBROUTINE p4z_chk_mass
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE p4z_sms( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt
-   END SUBROUTINE p4z_sms
-#endif 
-
    !!======================================================================
 END MODULE p4zsms 

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90

@@ -24 +24 @@
 #endif
 
-#if defined key_kriest
-   INTEGER, PARAMETER :: jpdta = 11
-#else
    INTEGER, PARAMETER :: jpdta = 12
-#endif
 
 

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90

@@ -40 +40 @@
 
    USE p4zsink , ONLY :  sinking    =>   sinking         !: sinking flux for POC
-#if ! defined key_kriest
    USE p4zsink , ONLY :  sinking2   =>   sinking2        !: sinking flux for GOC
-#endif
    USE p4zsink , ONLY :  sinkcal    =>   sinkcal         !: sinking flux for calcite
    USE p4zsink , ONLY :  sinksil    =>   sinksil         !: sinking flux for opal ( dsi )

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90

@@ -55 +55 @@
 
       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdta
-#if ! defined key_kriest
       REAL(wp), DIMENSION(:)  , ALLOCATABLE :: zdtap, zdtag
-#endif 
 
 
@@ -97 +95 @@
       ENDIF
 
-
-#if ! defined key_kriest   
       ! Initialization of temporaries arrays  
       ALLOCATE( zdtap(jpoce) )    ;   zdtap(:)    = 0. 
       ALLOCATE( zdtag(jpoce) )    ;   zdtag(:)    = 0.  
-#endif
-
 
       IF( MOD( kt - 1, nfreq ) == 0 ) THEN
@@ -122 +116 @@
                   trc_data(ji,jj,5)  = trn  (ji,jj,ikt,jpoxy)
                   trc_data(ji,jj,6)  = trn  (ji,jj,ikt,jpsil)
-#   if ! defined key_kriest
                   trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
                   trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
@@ -129 +122 @@
                   trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_tem)
                   trc_data(ji,jj,12) = tsn     (ji,jj,ikt,jp_sal)
-#   else
-                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
-                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
-                  trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt)
-                  trc_data(ji,jj,10) = tsn     (ji,jj,ikt,jp_tem)
-                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_sal)       
-#   endif
                ENDIF
             ENDDO
@@ -147 +133 @@
          CALL iom_get( numbio, jpdom_data, 'O2BOT'      , trc_data(:,:,5 ) )
          CALL iom_get( numbio, jpdom_data, 'SIBOT'      , trc_data(:,:,6 ) )
-#   if ! defined key_kriest
          CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 
          CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) ) 
@@ -154 +139 @@
          CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,11) ) 
          CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,12) ) 
-#   else
-         CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) ) 
-         CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) ) 
-         CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,9 ) ) 
-         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,10) ) 
-         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,11) ) 
-#   endif
 #endif
 
@@ -186 +164 @@
          !  Solid components : 
          !-----------------------
-#if ! defined key_kriest
          !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
          CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 
@@ -200 +177 @@
          CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
          CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) )
-#else
-         !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
-         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) ) 
-         rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4
-         !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
-         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jspoc), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )      
-         rainrm_dta(1:jpoce,jspoc) = rainrm_dta(1:jpoce,jspoc) * 1e-4
-         !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1
-         CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce) )
-         rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4
-         ! vector temperature [°C] and salinity 
-         CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) )
-         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
-
-#endif
         
          ! Clay rain rate in [mol/(cm**2.s)] 
@@ -252 +214 @@
 
       DEALLOCATE( zdta ) 
-#if ! defined key_kriest
       DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    ) 
-#endif      
 
       IF( kt == nitsedend )   THEN

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90

@@ -15 +15 @@
    PUBLIC sed_model  ! called by step.F90
 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
-
-   !! $Id$
 CONTAINS
 
@@ -47 +44 @@
    !! MODULE sedmodel  :   Dummy module 
    !!======================================================================
-   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
-   !! $Id$
 CONTAINS
    SUBROUTINE sed_model( kt )         ! Empty routine

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

@@ -13 +13 @@
    IMPLICIT NONE
 
-#if defined key_pisces_reduced
-   !!---------------------------------------------------------------------
-   !!   'key_pisces_reduced'   :                                LOBSTER bio-model
-   !!---------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE. !: p4z flag 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  6      !: number of passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  19     !: additional 2d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =   3     !: additional 3d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   17    !: number of sms trends for PISCES
+   ! productive layer depth
+   INTEGER, PUBLIC ::   jpkb       !: first vertical layers where biology is active
+   INTEGER, PUBLIC ::   jpkbm1     !: first vertical layers where biology is active
 
    ! assign an index in trc arrays for each LOBSTER prognostic variables
-   INTEGER, PUBLIC, PARAMETER ::   jpdet     =  1        !: detritus                    [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpzoo     =  2        !: zooplancton concentration   [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpphy     =  3        !: phytoplancton concentration [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpno3     =  4        !: nitrate concentration       [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpnh4     =  5        !: ammonium concentration      [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpdom     =  6        !: dissolved organic matter    [mmoleN/m3]
+   INTEGER, PUBLIC ::   jpdet     !: detritus                   
+   INTEGER, PUBLIC ::   jpdom     !: dissolved organic matter 
+   INTEGER, PUBLIC ::   jpdic     !: dissolved inoganic carbon concentration 
+   INTEGER, PUBLIC ::   jptal     !: total alkalinity 
+   INTEGER, PUBLIC ::   jpoxy     !: oxygen carbon concentration 
+   INTEGER, PUBLIC ::   jpcal     !: calcite  concentration 
+   INTEGER, PUBLIC ::   jppo4     !: phosphate concentration 
+   INTEGER, PUBLIC ::   jppoc     !: small particulate organic phosphate concentration
+   INTEGER, PUBLIC ::   jpsil     !: silicate concentration
+   INTEGER, PUBLIC ::   jpphy     !: phytoplancton concentration 
+   INTEGER, PUBLIC ::   jpzoo     !: zooplancton concentration
+   INTEGER, PUBLIC ::   jpdoc     !: dissolved organic carbon concentration 
+   INTEGER, PUBLIC ::   jpdia     !: Diatoms Concentration
+   INTEGER, PUBLIC ::   jpmes     !: Mesozooplankton Concentration
+   INTEGER, PUBLIC ::   jpdsi     !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC ::   jpfer     !: Iron Concentration
+   INTEGER, PUBLIC ::   jpbfe     !: Big iron particles Concentration
+   INTEGER, PUBLIC ::   jpgoc     !: big particulate organic phosphate concentration
+   INTEGER, PUBLIC ::   jpsfe     !: Small iron particles Concentration
+   INTEGER, PUBLIC ::   jpdfe     !: Diatoms iron Concentration
+   INTEGER, PUBLIC ::   jpgsi     !: (big) Silicate Concentration
+   INTEGER, PUBLIC ::   jpnfe     !: Nano iron Concentration
+   INTEGER, PUBLIC ::   jpnch     !: Nano Chlorophyll Concentration
+   INTEGER, PUBLIC ::   jpdch     !: Diatoms Chlorophyll Concentration
+   INTEGER, PUBLIC ::   jpno3     !: Nitrates Concentration
+   INTEGER, PUBLIC ::   jpnh4     !: Ammonium Concentration
+   INTEGER, PUBLIC ::   jpdon     !: dissolved organic nitrogen concentration
+   INTEGER, PUBLIC ::   jpdop     !: dissolved organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppon     !: small particulate organic nitrogen concentration
+   INTEGER, PUBLIC ::   jppop     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpnph     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppph     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpndi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppdi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppic     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpnpi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpppi     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppfe     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jppch     !: small particulate organic phosphorus concentration
+   INTEGER, PUBLIC ::   jpgon     !: Big nitrogen particles Concentration
+   INTEGER, PUBLIC ::   jpgop     !: Big phosphorus particles Concentration
+   INTEGER, PUBLIC ::   jplgw     !: Weak Ligands
+   INTEGER, PUBLIC ::   jpfep     !: Fe nanoparticle
 
-   ! productive layer depth
-   INTEGER, PUBLIC, PARAMETER ::   jpkb      = 12        !: first vertical layers where biology is active
-   INTEGER, PUBLIC, PARAMETER ::   jpkbm1    = jpkb - 1  !: first vertical layers where biology is active
-
-#elif defined key_pisces  &&  defined key_kriest
-   !!---------------------------------------------------------------------
-   !!   'key_pisces' & 'key_kriest'                 PISCES bio-model + ???
-   !!---------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE. !: p4z flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES
-
-   ! assign an index in trc arrays for each LOBSTER prognostic variables
-   !    WARNING: be carefull about the order when reading the restart
-        !   !!gm  this warning should be obsolet with IOM
-   INTEGER, PUBLIC, PARAMETER ::   jpdic =  1    !: dissolved inoganic carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jptal =  2    !: total alkalinity 
-   INTEGER, PUBLIC, PARAMETER ::   jpoxy =  3    !: oxygen carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpcal =  4    !: calcite  concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jppo4 =  5    !: phosphate concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jppoc =  6    !: small particulate organic phosphate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpsil =  7    !: silicate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpphy =  8    !: phytoplancton concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpzoo =  9    !: zooplancton concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdch = 21    !: Diatoms Chlorophyll Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpno3 = 22    !: Nitrates Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 23    !: Ammonium Concentration
-
-#elif defined key_pisces
-   !!---------------------------------------------------------------------
-   !!   'key_pisces'   :                         standard PISCES bio-model
-   !!---------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE.  !: p4z flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES
-
-   ! assign an index in trc arrays for each LOBSTER prognostic variables
-   !    WARNING: be carefull about the order when reading the restart
-        !   !!gm  this warning should be obsolet with IOM
-   INTEGER, PUBLIC, PARAMETER ::   jpdic =  1    !: dissolved inoganic carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jptal =  2    !: total alkalinity 
-   INTEGER, PUBLIC, PARAMETER ::   jpoxy =  3    !: oxygen carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpcal =  4    !: calcite  concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jppo4 =  5    !: phosphate concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jppoc =  6    !: small particulate organic phosphate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpsil =  7    !: silicate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpphy =  8    !: phytoplancton concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpzoo =  9    !: zooplancton concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration 
-   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgoc = 16    !: big particulate organic phosphate concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpdch = 22    !: Diatoms Chlorophyll Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpno3 = 23    !: Nitrates Concentration
-   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 24    !: Ammonium Concentration
-
-#else
    !!---------------------------------------------------------------------
    !!   Default                                   No CFC geochemical model
-   !!---------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .FALSE.  !: PISCES flag 
-   LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE.  !: p4z flag 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  0       !: No CFC tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  0       !: No CFC additional 2d output arrays 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  0       !: No CFC additional 3d output arrays 
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  0       !: number of sms trends for PISCES
-#endif
-
    ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = 1                  !: First index of PISCES tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_pisces          !: Last  index of PISCES tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = 1               !: First index of 2D diag
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_pisces_2d    !: Last  index of 2D diag
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = 1               !: First index of 3D diag
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_pisces_3d    !: Last  index of 3d diag
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = 1              !: First index of bio diag
-   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_pisces_trd  !: Last  index of bio diag
-
+   INTEGER, PUBLIC  ::   jp_pcs0  !: First index of PISCES tracers
+   INTEGER, PUBLIC  ::   jp_pcs1  !: Last  index of PISCES tracers
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

@@ -6 +6 @@
    !! History :   1.0  !  2000-02 (O. Aumont) original code
    !!             3.2  !  2009-04 (C. Ethe & NEMO team) style
-   !!----------------------------------------------------------------------
-#if defined key_pisces || defined key_pisces_reduced 
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                         PISCES model
    !!----------------------------------------------------------------------
    USE par_oce
@@ -21 +17 @@
    INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output
 
-   !!*  Biological fluxes for light : variables shared by pisces & lobster
-   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation)
-   !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure
    !                                                       !:  PISCES  : silicon dependant half saturation
 
-#if defined key_pisces 
+   !!* Model used
+   LOGICAL  ::  ln_p2z            !: Flag to use LOBSTER model
+   LOGICAL  ::  ln_p4z            !: Flag to use PISCES  model
+   LOGICAL  ::  ln_p5z            !: Flag to use PISCES  quota model
+   LOGICAL  ::  ln_ligand         !: Flag to enable organic ligands
+
    !!*  Time variables
    INTEGER  ::   nrdttrc           !: ???
@@ -49 +44 @@
    REAL(wp) ::   o2nit             !: ???
    REAL(wp) ::   wsbio, wsbio2     !: ???
+   REAL(wp) ::   wsbio2max         !: ???
+   REAL(wp) ::   wsbio2scale       !: ???
    REAL(wp) ::   xkmort            !: ???
    REAL(wp) ::   ferat3            !: ???
+   REAL(wp) ::   wfep              !: ???
+   REAL(wp) ::   ldocp             !: ???
+   REAL(wp) ::   ldocz             !: ???
+   REAL(wp) ::   lthet             !: ???
+   REAL(wp) ::   no3rat3           !: ???
+   REAL(wp) ::   po4rat3           !: ???
+
 
    !!*  diagnostic parameters 
@@ -66 +70 @@
    LOGICAL  ::  ln_check_mass      !: Flag to check mass conservation
 
+   !!*  Biological fluxes for light : variables shared by pisces & lobster
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot_ndcy      !: PAR over 24h in case of diurnal cycle
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  epico          !: PAR for pico
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  emoy           !: averaged PAR in the mixed layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup_01 !: Absolute euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure
+
    !!*  Biological fluxes for primary production
-   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xksimax    !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   biron      !: bioavailable fraction of iron
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   plig       !: proportion of iron organically complexed
+
+   !!*  Sinking speed
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsfep
+
 
 
@@ -87 +97 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ??
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ??
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ??
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbacl   !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   orem       !: ??
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ??
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodpoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   conspoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodgoc    !: Calcite production
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   consgoc    !: Calcite production
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizen      !: size of diatoms 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizep      !: size of diatoms 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sized      !: size of diatoms 
+
 
    !!* Variable for chemistry of the CO2 cycle
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ???
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ???
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ???
@@ -108 +123 @@
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates
 
-#if defined key_kriest
-   !!*  Kriest parameter for aggregation
-   REAL(wp) ::   xkr_eta                            !: Sinking  exponent 
-   REAL(wp) ::   xkr_zeta                           !:  N content exponent 
-   REAL(wp) ::   xkr_ncontent                       !:  N content factor   
-   REAL(wp) ::   xkr_massp                          !: 
-   REAL(wp) ::   xkr_mass_min, xkr_mass_max         !:  Minimum, Maximum mass for Aggregates 
+#if defined key_sed
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
 #endif
 
-#endif
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -124 +135 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
 
    INTEGER FUNCTION sms_pisces_alloc()
@@ -130 +142 @@
       !!----------------------------------------------------------------------
       USE lib_mpp , ONLY: ctl_warn
-      INTEGER ::   ierr(5)        ! Local variables
+      INTEGER ::   ierr(10)        ! Local variables
       !!----------------------------------------------------------------------
       ierr(:) = 0
       !*  Biological fluxes for light : shared variables for pisces & lobster
-      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), xksi(jpi,jpj), STAT=ierr(1) )
-      !
-#if defined key_pisces
-      !*  Biological fluxes for primary production
-      ALLOCATE( xksimax(jpi,jpj)     , biron   (jpi,jpj,jpk),       &
-         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       &
-         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       &
-         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       &
-         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       &
-         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       &
-         &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       &
-         &      concnfe (jpi,jpj,jpk),                           STAT=ierr(2) ) 
-         !
-      !*  SMS for the organic matter
-      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       &
-         &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),       & 
-         &      xlimbacl(jpi,jpj,jpk), prodcal(jpi,jpj,jpk),     STAT=ierr(3) )
-
-      !* Variable for chemistry of the CO2 cycle
-      ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       &
-         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       &
-         &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       &
-         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,       &
-         &      aphscale(jpi,jpj,jpk),                           STAT=ierr(4) )
-         !
-      !* Temperature dependancy of SMS terms
-      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) )
-         !
-#endif
+      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj),    &
+        &       heup_01(jpi,jpj) , xksi(jpi,jpj)               ,  STAT=ierr(1) )
+      !
+  
+      IF( ln_p4z .OR. ln_p5z ) THEN
+         !*  Biological fluxes for light 
+         ALLOCATE(  enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk) ,   &
+           &        etot_ndcy(jpi,jpj,jpk), emoy(jpi,jpj,jpk)  ,  STAT=ierr(2) ) 
+
+         !*  Biological fluxes for primary production
+         ALLOCATE( xksimax(jpi,jpj)  , biron(jpi,jpj,jpk)      ,  STAT=ierr(3) )
+         !
+         !*  SMS for the organic matter
+         ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk) ,    &
+            &      orem    (jpi,jpj,jpk),                           &
+            &      prodcal(jpi,jpj,jpk),  xdiss   (jpi,jpj,jpk),    &
+            &      prodpoc(jpi,jpj,jpk) , conspoc(jpi,jpj,jpk) ,    &
+            &      prodgoc(jpi,jpj,jpk) , consgoc(jpi,jpj,jpk) ,  STAT=ierr(4) )
+
+         !* Variable for chemistry of the CO2 cycle
+         ALLOCATE( ak13  (jpi,jpj,jpk) ,                            &
+            &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,     &
+            &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     &
+            &      aphscale(jpi,jpj,jpk),                         STAT=ierr(5) )
+         !
+         !* Temperature dependancy of SMS terms
+         ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk),   STAT=ierr(6) )
+         !
+         !* Sinkong speed
+         ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk),     &
+            &      wscal(jpi,jpj,jpk)                         ,   STAT=ierr(7) )   
+         ! 
+         IF( ln_ligand ) THEN
+           ALLOCATE( plig(jpi,jpj,jpk)  , wsfep(jpi,jpj,jpk)  ,   STAT=ierr(8) )
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( ln_p5z ) THEN
+         !       
+         ALLOCATE( epico(jpi,jpj,jpk)                         ,   STAT=ierr(9) ) 
+
+         !*  Size of phytoplankton cells
+         ALLOCATE( sizen(jpi,jpj,jpk), sizep(jpi,jpj,jpk),         &
+           &       sized(jpi,jpj,jpk),                            STAT=ierr(10) )
+      ENDIF
       !
       sms_pisces_alloc = MAXVAL( ierr )
@@ -170 +199 @@
    END FUNCTION sms_pisces_alloc
 
-#else
-   !!----------------------------------------------------------------------   
-   !!  Empty module :                                     NO PISCES model
-   !!----------------------------------------------------------------------
-#endif
-   
    !!======================================================================   
 END MODULE sms_pisces    

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code
-   !! Comment ! probably not properly done when the second particle export
-   !! scheme (kriest) is used
-   !!----------------------------------------------------------------------
-#if defined key_pisces || defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
    !!----------------------------------------------------------------------
    !! trc_ice_pisces   : PISCES fake sea ice model setting
@@ -18 +12 @@
    USE oce_trc         ! Shared variables between ocean and passive tracers
    USE trc             ! Passive tracers common variables 
-   USE phycst          ! Ocean physics parameters
    USE sms_pisces      ! PISCES Source Minus Sink variables
    USE in_out_manager
@@ -37 +30 @@
       !!----------------------------------------------------------------------
 
-      IF( lk_p4z ) THEN  ;   CALL p4z_ice_ini   !  PISCES
-      ELSE               ;   CALL p2z_ice_ini   !  LOBSTER
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ice_ini   !  PISCES
+      ELSE                           ;   CALL p2z_ice_ini   !  LOBSTER
       ENDIF
 
@@ -45 +38 @@
 
    SUBROUTINE p4z_ice_ini
-
-#if defined key_pisces 
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE p4z_ice_ini ***
@@ -75 +66 @@
 
                                         !--- Dummy variables
-      REAL(wp), DIMENSION(jp_pisces,2)  :: zratio  ! effective ice-ocean tracer cc ratio
-      REAL(wp), DIMENSION(jp_pisces,4)  :: zpisc   ! prescribes concentration 
+      REAL(wp), DIMENSION(jpmaxtrc,2) :: zratio  ! effective ice-ocean tracer cc ratio
+      REAL(wp), DIMENSION(jpmaxtrc,4) :: zpisc   ! prescribes concentration 
       !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic
 
@@ -107 +98 @@
       zpisc(jppo4,1) =  5.77e-7_wp / po4r 
       zpisc(jppoc,1) =  1.27e-6_wp  
-#  if ! defined key_kriest
       zpisc(jpgoc,1) =  5.23e-8_wp  
       zpisc(jpbfe,1) =  9.84e-13_wp 
-#  else
-      zpisc(jpnum,1) = 0. ! could not get this value since did not use it
-#  endif
       zpisc(jpsil,1) =  7.36e-6_wp  
       zpisc(jpdsi,1) =  1.07e-7_wp 
@@ -129 +116 @@
       zpisc(jpnh4,1) =  3.22e-7_wp / rno3
 
+      ! ln_p5z
+      zpisc(jppic,1) =  9.57e-8_wp
+      zpisc(jpnpi,1) =  9.57e-8_wp
+      zpisc(jpppi,1) =  9.57e-8_wp
+      zpisc(jppfe,1) =  1.76e-11_wp
+      zpisc(jppch,1) =  1.67e-7_wp
+      zpisc(jpnph,1) =  9.57e-8_wp
+      zpisc(jppph,1) =  9.57e-8_wp
+      zpisc(jpndi,1) =  4.24e-7_wp
+      zpisc(jppdi,1) =  4.24e-7_wp
+      zpisc(jppon,1) =  9.57e-8_wp
+      zpisc(jppop,1) =  9.57e-8_wp
+      zpisc(jpdon,1) =  2.04e-5_wp
+      zpisc(jpdop,1) =  2.04e-5_wp
+      zpisc(jpgon,1) =  5.23e-8_wp
+      zpisc(jpgop,1) =  5.23e-8_wp
+
       !--- Arctic specificities (dissolved inorganic & DOM)
       zpisc(jpdic,2) =  1.98e-3_wp 
@@ -137 +141 @@
       zpisc(jppo4,2) =  4.09e-7_wp / po4r 
       zpisc(jppoc,2) =  4.05e-7_wp  
-#  if ! defined key_kriest
       zpisc(jpgoc,2) =  2.84e-8_wp  
       zpisc(jpbfe,2) =  7.03e-13_wp 
-#  else
-      zpisc(jpnum,2) =  0.00e-00_wp 
-#  endif
       zpisc(jpsil,2) =  6.87e-6_wp  
       zpisc(jpdsi,2) =  1.73e-7_wp 
@@ -159 +159 @@
       zpisc(jpnh4,2) =  6.15e-08_wp / rno3 
 
+      ! ln_p5z
+      zpisc(jppic,2) =  5.25e-7_wp
+      zpisc(jpnpi,2) =  5.25e-7_wp
+      zpisc(jpppi,2) =  5.25e-7_wp
+      zpisc(jppfe,2) =  1.75e-11_wp
+      zpisc(jppch,2) =  1.46e-07_wp
+      zpisc(jpnph,2) =  5.25e-7_wp
+      zpisc(jppph,2) =  5.25e-7_wp
+      zpisc(jpndi,2) =  7.75e-7_wp
+      zpisc(jppdi,2) =  7.75e-7_wp
+      zpisc(jppon,2) =  4.05e-7_wp
+      zpisc(jppop,2) =  4.05e-7_wp
+      zpisc(jpdon,2) =  6.00e-6_wp
+      zpisc(jpdop,2) =  6.00e-6_wp
+      zpisc(jpgon,2) =  2.84e-8_wp
+      zpisc(jpgop,2) =  2.84e-8_wp
+
       !--- Antarctic specificities (dissolved inorganic & DOM)
       zpisc(jpdic,3) =  2.20e-3_wp  
@@ -167 +184 @@
       zpisc(jppo4,3) =  1.88e-6_wp / po4r  
       zpisc(jppoc,3) =  1.13e-6_wp  
-#  if ! defined key_kriest
       zpisc(jpgoc,3) =  2.89e-8_wp  
       zpisc(jpbfe,3) =  5.63e-13_wp 
-#  else
-      zpisc(jpnum,3) =  0.00e-00_wp 
-#  endif
       zpisc(jpsil,3) =  4.96e-5_wp  
       zpisc(jpdsi,3) =  5.63e-7_wp 
@@ -189 +202 @@
       zpisc(jpnh4,3) =  3.39e-7_wp / rno3  
 
+      ! ln_p5z
+      zpisc(jppic,3) =  8.10e-7_wp
+      zpisc(jpnpi,3) =  8.10e-7_wp
+      zpisc(jpppi,3) =  8.10e-7_wp 
+      zpisc(jppfe,3) =  1.48e-11_wp
+      zpisc(jppch,3) =  2.02e-7_wp
+      zpisc(jpnph,3) =  9.57e-8_wp
+      zpisc(jppph,3) =  9.57e-8_wp
+      zpisc(jpndi,3) =  5.77e-7_wp
+      zpisc(jppdi,3) =  5.77e-7_wp
+      zpisc(jppon,3) =  1.13e-6_wp
+      zpisc(jppop,3) =  1.13e-6_wp
+      zpisc(jpdon,3) =  7.02e-6_wp
+      zpisc(jpdop,3) =  7.02e-6_wp
+      zpisc(jpgon,3) =  2.89e-8_wp
+      zpisc(jpgop,3) =  2.89e-8_wp
+
+
       !--- Baltic Sea particular case for ORCA configurations
       zpisc(jpdic,4) = 1.14e-3_wp
@@ -197 +228 @@
       zpisc(jppo4,4) = 2.85e-9_wp / po4r
       zpisc(jppoc,4) = 4.84e-7_wp
-#  if ! defined key_kriest
       zpisc(jpgoc,4) = 1.05e-8_wp
       zpisc(jpbfe,4) = 4.97e-13_wp
-#  else
-      zpisc(jpnum,4) = 0. ! could not get this value
-#  endif
       zpisc(jpsil,4) = 4.91e-5_wp
       zpisc(jpdsi,4) = 3.25e-7_wp
@@ -218 +245 @@
       zpisc(jpno3,4) = 5.36e-5_wp / rno3
       zpisc(jpnh4,4) = 7.18e-7_wp / rno3
+
+      ! ln_p5z
+      zpisc(jppic,4) =  6.64e-7_wp
+      zpisc(jpnpi,4) =  6.64e-7_wp
+      zpisc(jpppi,4) =  6.64e-7_wp
+      zpisc(jppfe,4) =  3.89e-11_wp
+      zpisc(jppch,4) =  1.17e-7_wp
+      zpisc(jpnph,4) =  6.64e-7_wp
+      zpisc(jppph,4) =  6.64e-7_wp
+      zpisc(jpndi,4) =  3.41e-7_wp
+      zpisc(jppdi,4) =  3.41e-7_wp
+      zpisc(jppon,4) =  4.84e-7_wp
+      zpisc(jppop,4) =  4.84e-7_wp
+      zpisc(jpdon,4) =  1.06e-5_wp
+      zpisc(jpdop,4) =  1.06e-5_wp
+      zpisc(jpgon,4) =  1.05e-8_wp
+      zpisc(jpgop,4) =  1.05e-8_wp
  
       DO jn = jp_pcs0, jp_pcs1
@@ -279 +323 @@
       !
       END DO ! jn
-#endif
-
+      !
    END SUBROUTINE p4z_ice_ini
 
    SUBROUTINE p2z_ice_ini
-#if defined key_pisces_reduced 
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE p2z_ice_ini ***
@@ -290 +332 @@
       !! ** Purpose :   Initialisation of the LOBSTER biochemical model
       !!----------------------------------------------------------------------
-#endif
    END SUBROUTINE p2z_ice_ini
 
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                            No PISCES biochemical model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ice_ini_pisces         ! Empty routine
-   END SUBROUTINE trc_ice_ini_pisces
-#endif
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

@@ -11 +11 @@
    !!             3.5  !  2012-05  (C. Ethe) Merge PISCES-LOBSTER
    !!----------------------------------------------------------------------
-#if defined key_pisces || defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !! trc_ini_pisces   : PISCES biochemical model initialisation
    !!----------------------------------------------------------------------
-   USE par_trc         ! TOP parameters
+   USE par_trc         !  TOP parameters
    USE oce_trc         !  shared variables between ocean and passive tracers
    USE trc             !  passive tracers common variables 
+   USE trcnam_pisces   !  PISCES namelist
    USE sms_pisces      !  PISCES Source Minus Sink variables
 
@@ -41 +38 @@
       !!----------------------------------------------------------------------
 
-      IF( lk_p4z ) THEN  ;   CALL p4z_ini   !  PISCES
-      ELSE               ;   CALL p2z_ini   !  LOBSTER
+      !
+      CALL trc_nam_pisces
+      !
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES
+      ELSE                           ;   CALL p2z_ini   !  LOBSTER
       ENDIF
 
@@ -53 +53 @@
       !! ** Purpose :   Initialisation of the PISCES biochemical model
       !!----------------------------------------------------------------------
-#if defined key_pisces 
       !
       USE p4zsms          ! Main P4Z routine
@@ -70 +69 @@
       USE p4zlys          !  Calcite saturation
       USE p4zsed          !  Sedimentation & burial
+      USE p4zpoc          !  Remineralization of organic particles
+      USE p4zligand       !  Remineralization of organic ligands
+      USE p5zlim          !  Co-limitations of differents nutrients
+      USE p5zprod         !  Growth rate of the 2 phyto groups
+      USE p5zmicro        !  Sources and sinks of microzooplankton
+      USE p5zmeso         !  Sources and sinks of mesozooplankton
+      USE p5zmort         !  Mortality terms for phytoplankton
+
       !
       REAL(wp), SAVE :: sco2   =  2.312e-3_wp
@@ -79 +86 @@
       REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp
       !
-      INTEGER  ::  ji, jj, jk, ierr
+      INTEGER  ::  ji, jj, jk, jn, ierr
       REAL(wp) ::  zcaralk, zbicarb, zco3
       REAL(wp) ::  ztmas, ztmas1
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
-
-                                                 ! Allocate PISCES arrays
+      CHARACTER(len = 20)  ::  cltra
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( ln_p4z ) THEN 
+            WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation'
+         ELSE
+            WRITE(numout,*) ' p5z_ini :   PISCES biochemical model initialisation'
+            WRITE(numout,*) '             With variable stoichiometry'
+         ENDIF
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ENDIF
+      !
+      ! Allocate PISCES arrays
       ierr =         sms_pisces_alloc()          
       ierr = ierr +  p4z_che_alloc()
       ierr = ierr +  p4z_sink_alloc()
       ierr = ierr +  p4z_opt_alloc()
-      ierr = ierr +  p4z_prod_alloc()
-      ierr = ierr +  p4z_rem_alloc()
       ierr = ierr +  p4z_flx_alloc()
       ierr = ierr +  p4z_sed_alloc()
+      ierr = ierr +  p4z_rem_alloc()
+      IF( ln_p4z ) THEN
+         ierr = ierr +  p4z_lim_alloc()
+         ierr = ierr +  p4z_prod_alloc()
+      ELSE
+         ierr = ierr +  p5z_lim_alloc()
+         ierr = ierr +  p5z_prod_alloc()
+      ENDIF
       !
       IF( lk_mpp    )   CALL mpp_sum( ierr )
@@ -104 +126 @@
       r1_ryyss = 1. / ryyss
       !
+
+      ! assign an index in trc arrays for each prognostic variables
+      DO jn = 1, jptra
+        cltra = ctrcnm(jn) 
+        IF( cltra == 'DIC'      )   jpdic = jn      !: dissolved inoganic carbon concentration 
+        IF( cltra == 'Alkalini' )   jptal = jn      !: total alkalinity 
+        IF( cltra == 'O2'       )   jpoxy = jn      !: oxygen carbon concentration 
+        IF( cltra == 'CaCO3'    )   jpcal = jn      !: calcite  concentration 
+        IF( cltra == 'PO4'      )   jppo4 = jn      !: phosphate concentration 
+        IF( cltra == 'POC'      )   jppoc = jn      !: small particulate organic phosphate concentration
+        IF( cltra == 'Si'       )   jpsil = jn      !: silicate concentration
+        IF( cltra == 'PHY'      )   jpphy = jn      !: phytoplancton concentration 
+        IF( cltra == 'ZOO'      )   jpzoo = jn      !: zooplancton concentration
+        IF( cltra == 'DOC'      )   jpdoc = jn      !: dissolved organic carbon concentration 
+        IF( cltra == 'PHY2'     )   jpdia = jn      !: Diatoms Concentration
+        IF( cltra == 'ZOO2'     )   jpmes = jn      !: Mesozooplankton Concentration
+        IF( cltra == 'DSi'      )   jpdsi = jn      !: Diatoms Silicate Concentration
+        IF( cltra == 'Fer'      )   jpfer = jn      !: Iron Concentration
+        IF( cltra == 'BFe'      )   jpbfe = jn      !: Big iron particles Concentration
+        IF( cltra == 'GOC'      )   jpgoc = jn      !: Big particulate organic phosphate concentration
+        IF( cltra == 'SFe'      )   jpsfe = jn      !: Small iron particles Concentration
+        IF( cltra == 'DFe'      )   jpdfe = jn      !: Diatoms iron Concentration
+        IF( cltra == 'GSi'      )   jpgsi = jn      !: (big) Silicate Concentration
+        IF( cltra == 'NFe'      )   jpnfe = jn      !: Nano iron Concentration
+        IF( cltra == 'NCHL'     )   jpnch = jn      !: Nano Chlorophyll Concentration
+        IF( cltra == 'DCHL'     )   jpdch = jn      !: Diatoms Chlorophyll Concentration
+        IF( cltra == 'NO3'      )   jpno3 = jn      !: Nitrates Concentration
+        IF( cltra == 'NH4'      )   jpnh4 = jn      !: Ammonium Concentration
+        IF( cltra == 'DON'      )   jpdon = jn      !: Dissolved organic N Concentration
+        IF( cltra == 'DOP'      )   jpdop = jn      !: Dissolved organic P Concentration
+        IF( cltra == 'PON'      )   jppon = jn      !: Small Nitrogen particle Concentration
+        IF( cltra == 'POP'      )   jppop = jn      !: Small Phosphorus particle Concentration
+        IF( cltra == 'GON'      )   jpgon = jn      !: Big Nitrogen particles Concentration
+        IF( cltra == 'GOP'      )   jpgop = jn      !: Big Phosphorus Concentration
+        IF( cltra == 'PHYN'     )   jpnph = jn      !: Nanophytoplankton N biomass
+        IF( cltra == 'PHYP'     )   jppph = jn      !: Nanophytoplankton P biomass
+        IF( cltra == 'DIAN'     )   jpndi = jn      !: Diatoms N biomass
+        IF( cltra == 'DIAP'     )   jppdi = jn      !: Diatoms P biomass
+        IF( cltra == 'PIC'      )   jppic = jn      !: Picophytoplankton C biomass
+        IF( cltra == 'PICN'     )   jpnpi = jn      !: Picophytoplankton N biomass
+        IF( cltra == 'PICP'     )   jpppi = jn      !: Picophytoplankton P biomass
+        IF( cltra == 'PFe'      )   jppfe = jn      !: Picophytoplankton Fe biomass
+        IF( cltra == 'LGW'      )   jplgw = jn      !: Weak ligands
+        IF( cltra == 'LFe'      )   jpfep = jn      !: Fe nanoparticle
+      ENDDO
 
       CALL p4z_sms_init       !  Maint routine
@@ -116 +183 @@
       rdenit  =  ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3
       rdenita =   3._wp /  5._wp
-
+      IF( ln_p5z ) THEN
+         no3rat3 = no3rat3 / rno3
+         po4rat3 = po4rat3 / po4r
+      ENDIF
 
       ! Initialization of tracer concentration in case of  no restart 
       !--------------------------------------------------------------
-      IF( .NOT. ln_rsttr ) THEN  
-         
+      IF( .NOT.ln_rsttr ) THEN  
          trn(:,:,:,jpdic) = sco2
          trn(:,:,:,jpdoc) = bioma0
@@ -129 +198 @@
          trn(:,:,:,jppo4) = po4 / po4r
          trn(:,:,:,jppoc) = bioma0
-#  if ! defined key_kriest
          trn(:,:,:,jpgoc) = bioma0
          trn(:,:,:,jpbfe) = bioma0 * 5.e-6
-#  else
-         trn(:,:,:,jpnum) = bioma0 / ( 6. * xkr_massp )
-#  endif
          trn(:,:,:,jpsil) = silic1
          trn(:,:,:,jpdsi) = bioma0 * 0.15
@@ -150 +215 @@
          trn(:,:,:,jpno3) = no3
          trn(:,:,:,jpnh4) = bioma0
-
+         IF( ln_ligand) THEN
+            trn(:,:,:,jplgw) = 0.6E-9
+            trn(:,:,:,jpfep) = 0. * 5.e-6
+         ENDIF
+         IF( ln_p5z ) THEN
+            trn(:,:,:,jpdon) = bioma0
+            trn(:,:,:,jpdop) = bioma0
+            trn(:,:,:,jppon) = bioma0
+            trn(:,:,:,jppop) = bioma0
+            trn(:,:,:,jpgon) = bioma0
+            trn(:,:,:,jpgop) = bioma0
+            trn(:,:,:,jpnph) = bioma0
+            trn(:,:,:,jppph) = bioma0
+            trn(:,:,:,jppic) = bioma0
+            trn(:,:,:,jpnpi) = bioma0
+            trn(:,:,:,jpppi) = bioma0
+            trn(:,:,:,jpndi) = bioma0
+            trn(:,:,:,jppdi) = bioma0
+            trn(:,:,:,jppfe) = bioma0 * 5.e-6
+            trn(:,:,:,jppch) = bioma0 * 12. / 55.
+         ENDIF
          ! initialize the half saturation constant for silicate
          ! ----------------------------------------------------
@@ -158 +243 @@
 
 
-      CALL p4z_sink_init      !  vertical flux of particulate organic matter
-      CALL p4z_opt_init       !  Optic: PAR in the water column
-      CALL p4z_lim_init       !  co-limitations by the various nutrients
-      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.
-      CALL p4z_sbc_init       !  boundary conditions
-      CALL p4z_fechem_init    !  Iron chemistry
-      CALL p4z_rem_init       !  remineralisation
-      CALL p4z_mort_init      !  phytoplankton mortality 
-      CALL p4z_micro_init     !  microzooplankton
-      CALL p4z_meso_init      !  mesozooplankton
-      CALL p4z_lys_init       !  calcite saturation
-      CALL p4z_flx_init       !  gas exchange 
+      CALL p4z_sink_init         !  vertical flux of particulate organic matter
+      CALL p4z_opt_init          !  Optic: PAR in the water column
+      IF( ln_p4z ) THEN
+         CALL p4z_lim_init       !  co-limitations by the various nutrients
+         CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.
+      ELSE
+         CALL p5z_lim_init       !  co-limitations by the various nutrients
+         CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean.
+      ENDIF
+      CALL p4z_sbc_init          !  boundary conditions
+      CALL p4z_fechem_init       !  Iron chemistry
+      CALL p4z_rem_init          !  remineralisation
+      CALL p4z_poc_init          !  remineralisation of organic particles
+      IF( ln_ligand ) &
+         & CALL p4z_ligand_init  !  remineralisation of organic ligands
+
+      IF( ln_p4z ) THEN
+         CALL p4z_mort_init      !  phytoplankton mortality 
+         CALL p4z_micro_init     !  microzooplankton
+         CALL p4z_meso_init      !  mesozooplankton
+      ELSE
+         CALL p5z_mort_init      !  phytoplankton mortality 
+         CALL p5z_micro_init     !  microzooplankton
+         CALL p5z_meso_init      !  mesozooplankton
+      ENDIF
+      CALL p4z_lys_init          !  calcite saturation
+      IF( .NOT.l_co2cpl ) &
+        & CALL p4z_flx_init      !  gas exchange 
 
       ndayflxtr = 0
@@ -176 +277 @@
       IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done'
       IF(lwp) WRITE(numout,*) 
-#endif
       !
    END SUBROUTINE p4z_ini
@@ -186 +286 @@
       !! ** Purpose :   Initialisation of the LOBSTER biochemical model
       !!----------------------------------------------------------------------
-#if defined key_pisces_reduced 
       !
       USE p2zopt
@@ -193 +292 @@
       USE p2zsed
       !
-      INTEGER  ::  ji, jj, jk, ierr
+      INTEGER  ::  ji, jj, jk, jn, ierr
+      CHARACTER(len = 10)  ::  cltra
       !!----------------------------------------------------------------------
 
@@ -205 +305 @@
       IF( lk_mpp    )   CALL mpp_sum( ierr )
       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' )
+
+      DO jn = 1, jptra
+        cltra = ctrcnm(jn) 
+        IF( cltra == 'DET' )   jpdet = jn       !: detritus                    [mmoleN/m3]
+        IF( cltra == 'ZOO' )   jpzoo = jn       !: zooplancton concentration   [mmoleN/m3]
+        IF( cltra == 'PHY' )   jpphy = jn       !: phytoplancton concentration [mmoleN/m3]
+        IF( cltra == 'NO3' )   jpno3 = jn       !: nitrate concentration       [mmoleN/m3]
+        IF( cltra == 'NH4' )   jpnh4 = jn       !: ammonium concentration      [mmoleN/m3]
+        IF( cltra == 'DOM' )   jpdom = jn       !: dissolved organic matter    [mmoleN/m3]
+      ENDDO
+
+      jpkb = 10        !  last level where depth less than 200 m
+      DO jk = jpkm1, 1, -1
+         IF( gdept_1d(jk) > 200. ) jpkb = jk 
+      END DO
+      IF (lwp) WRITE(numout,*)
+      IF (lwp) WRITE(numout,*) ' first vertical layers where biology is active (200m depth ) ', jpkb
+      IF (lwp) WRITE(numout,*)
+      jpkbm1 = jpkb - 1
+      !
+
 
       ! LOBSTER initialisation for GYRE : init NO3=f(density) by asklod AS Kremeur 2005-07
@@ -214 +335 @@
          trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:)
          trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:)
-         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3 ) = 2._wp * tmask(:,:,:)
+         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:)
          ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:)
          END WHERE                       
@@ -227 +348 @@
       IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done'
       IF(lwp) WRITE(numout,*) 
-#endif
       !
    END SUBROUTINE p2z_ini
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module                            No PISCES biochemical model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ini_pisces             ! Empty routine
-   END SUBROUTINE trc_ini_pisces
-#endif
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

@@ -8 +8 @@
    !!             1.0  !  2003-08 (C. Ethe)  module F90
    !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90
-   !!----------------------------------------------------------------------
-#if defined key_pisces || defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'   :                                   PISCES bio-model
    !!----------------------------------------------------------------------
    !! trc_nam_pisces       : PISCES model namelist read
@@ -45 +41 @@
       !! ** input   :   file 'namelist.trc.sms' containing the following
       !!             namelist: natext, natbio, natsms
-      !!                       natkriest ("key_kriest")
       !!----------------------------------------------------------------------
       !!
       INTEGER :: jl, jn
-      INTEGER :: ios                 ! Local integer output status for namelist read
-      TYPE(DIAG), DIMENSION(jp_pisces_2d)  :: pisdia2d
-      TYPE(DIAG), DIMENSION(jp_pisces_3d)  :: pisdia3d
-      TYPE(DIAG), DIMENSION(jp_pisces_trd) :: pisdiabio
+      INTEGER :: ios, ioptio                 ! Local integer output status for namelist read
       CHARACTER(LEN=20)   ::   clname
       !!
-      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics
-#if defined key_pisces_reduced
-      NAMELIST/nampisdbi/ pisdiabio
-#endif
-
+      NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand
       !!----------------------------------------------------------------------
 
       IF(lwp) WRITE(numout,*)
       clname = 'namelist_pisces'
-#if defined key_pisces
+
       IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist'
-#else
-      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read LOBSTER namelist'
-#endif
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
       CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
@@ -74 +59 @@
       IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
       !
-      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
-         !
-         ! Namelist nampisdia
-         ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics
-         READ  ( numnatp_ref, nampisdia, IOSTAT = ios, ERR = 901)
-901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in reference namelist', lwp )
 
-         REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics
-         READ  ( numnatp_cfg, nampisdia, IOSTAT = ios, ERR = 902 )
-902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in configuration namelist', lwp )
-         IF(lwm) WRITE ( numonp, nampisdia )
+      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables
+      READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp )
 
-         DO jl = 1, jp_pisces_2d
-            jn = jp_pcs0_2d + jl - 1
-            ctrc2d(jn) = pisdia2d(jl)%sname
-            ctrc2l(jn) = pisdia2d(jl)%lname
-            ctrc2u(jn) = pisdia2d(jl)%units
-         END DO
+      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables
+      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp )
+      IF(lwm) WRITE ( numonp, nampismod )
 
-         DO jl = 1, jp_pisces_3d
-            jn = jp_pcs0_3d + jl - 1
-            ctrc3d(jn) = pisdia3d(jl)%sname
-            ctrc3l(jn) = pisdia3d(jl)%lname
-            ctrc3u(jn) = pisdia3d(jl)%units
-         END DO
-
-         IF(lwp) THEN                   ! control print
-            WRITE(numout,*)
-            WRITE(numout,*) ' Namelist : natadd'
-            DO jl = 1, jp_pisces_3d
-               jn = jp_pcs0_3d + jl - 1
-               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
-                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
-            END DO
-            WRITE(numout,*) ' '
-
-            DO jl = 1, jp_pisces_2d
-               jn = jp_pcs0_2d + jl - 1
-               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
-                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
-            END DO
-            WRITE(numout,*) ' '
-         ENDIF
-         !
+     IF(lwp) THEN                  ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Flag to use LOBSTER model            ln_p2z    = ', ln_p2z
+         WRITE(numout,*) ' Flag to use PISCES standard  model   ln_p4z    = ', ln_p4z
+         WRITE(numout,*) ' Flag to use PISCES quota     model   ln_p5z    = ', ln_p5z
+         WRITE(numout,*) ' Flag to ligand                       ln_ligand = ', ln_ligand
+         WRITE(numout,*) ' '
       ENDIF
 
-#if defined key_pisces_reduced
-
-      IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN
-         !
-         ! Namelist nampisdbi
-         ! -------------------
-         REWIND( numnatp_ref )              ! Namelist nampisdbi in reference namelist : Pisces add. diagnostics
-         READ  ( numnatp_ref, nampisdbi, IOSTAT = ios, ERR = 903)
-903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in reference namelist', lwp )
-
-         REWIND( numnatp_cfg )              ! Namelist nampisdbi in configuration namelist : Pisces add. diagnostics
-         READ  ( numnatp_cfg, nampisdbi, IOSTAT = ios, ERR = 904 )
-904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in configuration namelist', lwp )
-         IF(lwm) WRITE ( numonp, nampisdbi )
-
-         DO jl = 1, jp_pisces_trd
-            jn = jp_pcs0_trd + jl - 1
-            ctrbio(jl) = pisdiabio(jl)%sname
-            ctrbil(jl) = pisdiabio(jl)%lname
-            ctrbiu(jl) = pisdiabio(jl)%units
-         END DO
-
-         IF(lwp) THEN                   ! control print
-            WRITE(numout,*)
-            WRITE(numout,*) ' Namelist : nampisdbi'
-            DO jl = 1, jp_pisces_trd
-               jn = jp_pcs0_trd + jl - 1
-               WRITE(numout,*) '  biological trend No : ', jn, '    short name : ', ctrbio(jn), &
-                 &             '  long name  : ', ctrbio(jn), '   unit : ', ctrbio(jn)
-            END DO
-            WRITE(numout,*) ' '
-         END IF
-         !
-      END IF
-
-#endif
-
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         IF( ln_p5z    )  WRITE(numout,*) '  PISCES QUOTA model is used'
+         IF( ln_p4z    )  WRITE(numout,*) '  PISCES STANDARD model is used'
+         IF( ln_p2z    )  WRITE(numout,*) '  LOBSTER model is used'
+         IF( ln_ligand )  WRITE(numout,*) '  Compute remineralization/dissolution of organic ligands'
+         WRITE(numout,*) ' '
+      ENDIF
+    
+      ioptio = 0
+      IF( ln_p2z )    ioptio = ioptio + 1
+      IF( ln_p4z )    ioptio = ioptio + 1
+      IF( ln_p5z )    ioptio = ioptio + 1
+      !
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE PISCES model namelist nampismod' )
+       !
    END SUBROUTINE trc_nam_pisces
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                   No PISCES bio-model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_nam_pisces                      ! Empty routine
-   END  SUBROUTINE  trc_nam_pisces
-#endif  
 
    !!======================================================================

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

@@ -7 +7 @@
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
    !!----------------------------------------------------------------------
-#if defined key_pisces || defined key_pisces_reduced
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'                                       PISCES bio-model
-   !!----------------------------------------------------------------------
    !!   trcsms_pisces        :  Time loop of passive tracers sms
    !!----------------------------------------------------------------------
    USE par_pisces
+   USE sms_pisces
    USE p4zsms
    USE p2zsms
@@ -48 +45 @@
       !!---------------------------------------------------------------------
       !
-      IF( lk_p4z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES
-      ELSE               ;   CALL p2z_sms( kt )   !  LOBSTER
+      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES
+      ELSE                           ;   CALL p2z_sms( kt )   !  LOBSTER
       ENDIF
 
@@ -55 +52 @@
    END SUBROUTINE trc_sms_pisces
 
-#else
-   !!======================================================================
-   !!  Dummy module :                                   No PISCES bio-model
-   !!======================================================================
-CONTAINS
-   SUBROUTINE trc_sms_pisces( kt )                   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt
-      WRITE(*,*) 'trc_sms_pisces: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_sms_pisces
-#endif 
-
    !!======================================================================
 END MODULE trcsms_pisces 

branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

@@ -6 +6 @@
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
    !!----------------------------------------------------------------------
-#if defined key_top && defined key_iomput && ( defined key_pisces || defined key_pisces_reduced )
-   !!----------------------------------------------------------------------
-   !!   'key_pisces or key_pisces_reduced'                     PISCES model
+#if defined key_top && defined key_iomput 
    !!----------------------------------------------------------------------
    !! trc_wri_pisces   :  outputs of concentration fields
@@ -42 +40 @@
       ! write the tracer concentrations in the file
       ! ---------------------------------------
-#if defined key_pisces_reduced
-      DO jn = jp_pcs0, jp_pcs1
-         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         CALL iom_put( cltra, trn(:,:,:,jn) )
-      END DO
-#else
-      DO jn = jp_pcs0, jp_pcs1
-         zfact = 1.0e+6 
-         IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6 
-         IF( jn == jppo4  )                 zfact = po4r * 1.0e+6
-         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
-         IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact )
-      END DO
+      IF( ln_p2z ) THEN
+         DO jn = jp_pcs0, jp_pcs1
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            CALL iom_put( cltra, trn(:,:,:,jn) )
+         END DO
+      ELSE
+         DO jn = jp_pcs0, jp_pcs1
+            zfact = 1.0e+6 
+            IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6 
+            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact )
+         END DO
 
-      IF( iom_use( "INTDIC" ) ) THEN                     !   DIC content in kg/m2
-         zdic(:,:) = 0.
-         DO jk = 1, jpkm1
-            zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.
-         ENDDO
-         CALL iom_put( 'INTDIC', zdic )     
-      ENDIF
-      !
-      IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth 
-         zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1)
-         zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1)
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  IF( tmask(ji,jj,jk) == 1 ) then
-                     IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then
-                        zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy)
-                        zdepo2min(ji,jj) = gdepw_n(ji,jj,jk)
+         IF( iom_use( "INTDIC" ) ) THEN                     !   DIC content in kg/m2
+            zdic(:,:) = 0.
+            DO jk = 1, jpkm1
+               zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12.
+            ENDDO
+            CALL iom_put( 'INTDIC', zdic )     
+         ENDIF
+         !
+         IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth 
+            zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1)
+            zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1)
+            DO jk = 2, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( tmask(ji,jj,jk) == 1 ) then
+                        IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then
+                           zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy)
+                           zdepo2min(ji,jj) = gdepw_n(ji,jj,jk)
+                        ENDIF
                      ENDIF
-                  ENDIF
+                  END DO
                END DO
             END DO
-         END DO
-         !
-         CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration
-         CALL iom_put('ZO2MIN', zdepo2min  )                              ! depth of oxygen minimum concentration
-          !
-      ENDIF
-#endif
+            !
+            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration
+            CALL iom_put('ZO2MIN', zdepo2min  )                              ! depth of oxygen minimum concentration
+             !
+         ENDIF
+     ENDIF
       !
    END SUBROUTINE trc_wri_pisces