Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (5 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
2 deleted
71 edited
10 copied

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r3680 r7646  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    13    USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    14    USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES 
    15    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1612 
    1713   IMPLICIT NONE 
    18  
    19    INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     !: cumulative number of passive tracers 
    20    INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  !: 
    21    INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  !: 
    22    INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd !: 
    23     
    24 #if defined key_cfc 
    25    !!--------------------------------------------------------------------- 
    26    !!   'key_cfc'   :                                          CFC tracers 
    27    !!--------------------------------------------------------------------- 
    28    LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag  
    29    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd') 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
    33     
    34    ! assign an index in trc arrays for each CFC prognostic variables 
    35    INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11  
    36    INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12    
    37 #else 
    38    !!--------------------------------------------------------------------- 
    39    !!   Default     :                                       No CFC tracers 
    40    !!--------------------------------------------------------------------- 
    41    LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .FALSE.     !: CFC flag  
    42    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  0          !: No CFC tracers 
    43    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  0          !: No CFC additional 2d output arrays  
    44    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: No CFC additional 3d output arrays  
    45    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
    46 #endif 
    47  
    48    ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 
    49    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers 
    50    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers 
    51    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers 
    52    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers 
    54    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
    55    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers 
    56    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers 
     14   INTEGER, PUBLIC  :: jp_cfc0, jp_cfc1  !:  First/last index of CFC tracers 
    5715 
    5816   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90

    r5434 r7646  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    117   !!---------------------------------------------------------------------- 
    128   !! trc_ice_cfc       : MY_TRC model main routine 
     
    4036   END SUBROUTINE trc_ice_ini_cfc 
    4137 
    42  
    43 #else 
    44    !!---------------------------------------------------------------------- 
    45    !!   Dummy module                                        No MY_TRC model 
    46    !!---------------------------------------------------------------------- 
    47 CONTAINS 
    48    SUBROUTINE trc_ice_ini_cfc             ! Empty routine 
    49    END SUBROUTINE trc_ice_ini_cfc 
    50 #endif 
    51  
    5238   !!====================================================================== 
    5339END MODULE trcice_cfc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r3294 r7646  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_ini_cfc      : CFC model initialisation 
     
    1512   USE par_trc         ! TOP parameters 
    1613   USE trc             ! TOP variables 
     14   USE trcnam_cfc      ! CFC SMS namelist 
    1715   USE trcsms_cfc      ! CFC sms trends 
    1816 
     
    2119 
    2220   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module 
    23  
    24    CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ??? 
    2521 
    2622   INTEGER  ::   inum                   ! unit number 
     
    4642      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
    4743      REAL(wp) ::  zyy, zyd 
     44      CHARACTER(len = 20)  ::  cltra 
    4845      !!---------------------------------------------------------------------- 
    49  
     46      ! 
     47      CALL trc_nam_cfc 
     48      ! 
    5049      IF(lwp) WRITE(numout,*) 
    5150      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 
    5251      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    53  
    54  
    55       IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
     52      ! 
     53      IF(lwp) WRITE(numout,*) 'Read annual atmospheric concentratioins from formatted file : ' // TRIM(clname) 
    5654       
    5755      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     
    6664      END DO 
    6765 100  jpyear = jn - 1 - iskip 
    68       IF ( lwp) WRITE(numout,*) '    ', jpyear ,' years read' 
     66      IF ( lwp) WRITE(numout,*) '   ---> ', jpyear ,' years read' 
    6967      !                                ! Allocate CFC arrays 
    7068 
    71       ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr ) 
     69      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 
    7270      IF( ierr > 0 ) THEN 
    7371         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN 
     
    8785         IF(lwp) THEN 
    8886            WRITE(numout,*) 
    89             WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
     87            WRITE(numout,*) 'Initialisation of qint ; No restart : qint equal zero ' 
    9088         ENDIF 
    9189         qint_cfc(:,:,:) = 0._wp 
     
    105103      jn = 31 
    106104      DO  
    107         READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
     105        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 
    108106        IF( io < 0 ) exit 
    109107        jn = jn + 1 
    110108      END DO 
    111109 
    112       p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
    113       p_cfc(33,1:2,1) = 8.e-4 
    114       p_cfc(34,1:2,1) = 1.e-6 
    115       p_cfc(35,1:2,1) = 2.e-3 
    116       p_cfc(36,1:2,1) = 4.e-3 
    117       p_cfc(37,1:2,1) = 6.e-3 
    118       p_cfc(38,1:2,1) = 8.e-3 
    119       p_cfc(39,1:2,1) = 1.e-2 
    120        
     110      !p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
     111      !p_cfc(33,1:2,1) = 8.e-4 
     112      !p_cfc(34,1:2,1) = 1.e-6 
     113      !p_cfc(35,1:2,1) = 2.e-3 
     114      !p_cfc(36,1:2,1) = 4.e-3 
     115      !p_cfc(37,1:2,1) = 6.e-3 
     116      !p_cfc(38,1:2,1) = 8.e-3 
     117      !p_cfc(39,1:2,1) = 1.e-2 
    121118      IF(lwp) THEN        ! Control print 
    122119         WRITE(numout,*) 
    123          WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
     120         WRITE(numout,*) ' Year   c11NH     c11SH     c12NH     c12SH     SF6NH     SF6SH' 
    124121         DO jn = 30, jpyear 
    125             WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     122            WRITE(numout, '( 1I4, 6F10.4)') jn, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 
    126123         END DO 
    127124      ENDIF 
     
    145142      ! 
    146143   END SUBROUTINE trc_ini_cfc 
    147     
    148 #else 
    149    !!---------------------------------------------------------------------- 
    150    !!   Dummy module                                         No CFC tracers 
    151    !!---------------------------------------------------------------------- 
    152 CONTAINS 
    153    SUBROUTINE trc_ini_cfc             ! Empty routine 
    154    END SUBROUTINE trc_ini_cfc 
    155 #endif 
    156144 
    157145   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r4624 r7646  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    11    !!---------------------------------------------------------------------- 
    128   !! trc_nam_cfc      : CFC model initialisation 
    139   !!---------------------------------------------------------------------- 
    1410   USE oce_trc         ! Ocean variables 
    15    USE par_trc         ! TOP parameters 
    1611   USE trc             ! TOP variables 
    1712   USE trcsms_cfc      ! CFC specific variable 
    18    USE iom             ! I/O manager 
    1913 
    2014   IMPLICIT NONE 
    2115   PRIVATE 
     16 
     17   CHARACTER(len=34), PUBLIC ::   clname ! Input filename of CFCs atm. concentrations 
    2218 
    2319   PUBLIC   trc_nam_cfc   ! called by trcnam.F90 module 
     
    4238      !! ** input   :   Namelist namcfc 
    4339      !!---------------------------------------------------------------------- 
    44       INTEGER ::  numnatc_ref = -1   ! Logical unit for reference CFC namelist 
    45       INTEGER ::  numnatc_cfg = -1   ! Logical unit for configuration CFC namelist 
    46       INTEGER ::  numonc      = -1   ! Logical unit for output namelist 
    4740      INTEGER :: ios                 ! Local integer output status for namelist read 
    4841      INTEGER :: jl, jn 
    49       TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5042      !! 
    51       NAMELIST/namcfcdate/ ndate_beg, nyear_res 
    52       NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
     43      NAMELIST/namcfc/ ndate_beg, nyear_res, clname 
    5344      !!---------------------------------------------------------------------- 
    54       !                             ! Open namelist files 
    55       CALL ctl_opn( numnatc_ref, 'namelist_cfc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    56       CALL ctl_opn( numnatc_cfg, 'namelist_cfc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    57       IF(lwm) CALL ctl_opn( numonc, 'output.namelist.cfc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     45      ! 
     46      jn = jp_cfc0 - 1 
     47      ! Variables setting 
     48      IF( ln_cfc11 ) THEN 
     49         jn = jn + 1 
     50         ctrcnm    (jn) = 'CFC11' 
     51         ctrcln    (jn) = 'Chlorofluoro carbon 11 Concentration' 
     52         ctrcun    (jn) = 'umolC/L' 
     53         ln_trc_ini(jn) = .false. 
     54         ln_trc_sbc(jn) = .false. 
     55         ln_trc_cbc(jn) = .false. 
     56         ln_trc_obc(jn) = .false. 
     57      ENDIF 
     58      ! 
     59      IF( ln_cfc12 ) THEN 
     60         jn = jn + 1 
     61         ctrcnm    (jn) = 'CFC12' 
     62         ctrcln    (jn) = 'Chlorofluoro carbon 12 Concentration' 
     63         ctrcun    (jn) = 'umolC/L' 
     64         ln_trc_ini(jn) = .false. 
     65         ln_trc_sbc(jn) = .false. 
     66         ln_trc_cbc(jn) = .false. 
     67         ln_trc_obc(jn) = .false. 
     68      ENDIF 
     69      ! 
     70      IF( ln_sf6 ) THEN 
     71         jn = jn + 1 
     72         ctrcnm    (jn) = 'SF6' 
     73         ctrcln    (jn) = 'Sulfur hexafluoride Concentration' 
     74         ctrcun    (jn) = 'umol/L' 
     75         ln_trc_ini(jn) = .false. 
     76         ln_trc_sbc(jn) = .false. 
     77         ln_trc_cbc(jn) = .false. 
     78         ln_trc_obc(jn) = .false. 
     79      ENDIF 
     80      ! 
     81      REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
     82      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
     83901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 
    5884 
    59       REWIND( numnatc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
    60       READ  ( numnatc_ref, namcfcdate, IOSTAT = ios, ERR = 901) 
    61 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in reference namelist', lwp ) 
    62  
    63       REWIND( numnatc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
    64       READ  ( numnatc_cfg, namcfcdate, IOSTAT = ios, ERR = 902 ) 
    65 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in configuration namelist', lwp ) 
    66       IF(lwm) WRITE ( numonc, namcfcdate ) 
     85      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
     86      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
     87902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 
     88      IF(lwm) WRITE ( numonr, namcfc ) 
    6789 
    6890      IF(lwp) THEN                  ! control print 
    69          WRITE(numout,*) 
     91         WRITE(numout,*) ' ' 
     92         WRITE(numout,*) ' CFCs' 
     93         WRITE(numout,*) ' ' 
    7094         WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model' 
    7195         WRITE(numout,*) ' ~~~~~~~' 
     
    76100      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    77101      ! 
    78  
    79       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    80          ! 
    81          ! Namelist namcfcdia 
    82          ! ------------------- 
    83          REWIND( numnatc_ref )              ! Namelist namcfcdia in reference namelist : CFC diagnostics 
    84          READ  ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903) 
    85 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp ) 
    86  
    87          REWIND( numnatc_cfg )              ! Namelist namcfcdia in configuration namelist : CFC diagnostics 
    88          READ  ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 ) 
    89 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp ) 
    90          IF(lwm) WRITE ( numonc, namcfcdia ) 
    91  
    92          DO jl = 1, jp_cfc_2d 
    93             jn = jp_cfc0_2d + jl - 1 
    94             ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 
    95             ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 
    96             ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 
    97          END DO 
    98  
    99          IF(lwp) THEN                   ! control print 
    100             WRITE(numout,*) 
    101             WRITE(numout,*) ' Namelist : natadd' 
    102             DO jl = 1, jp_cfc_2d 
    103                jn = jp_cfc0_2d + jl - 1 
    104                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    105                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    106             END DO 
    107             WRITE(numout,*) ' ' 
    108          ENDIF 
    109          ! 
    110       ENDIF 
    111  
    112    IF(lwm) CALL FLUSH ( numonc )     ! flush output namelist CFC 
     102      IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC 
    113103 
    114104   END SUBROUTINE trc_nam_cfc 
    115105    
    116 #else 
    117    !!---------------------------------------------------------------------- 
    118    !!  Dummy module :                                                No CFC 
    119    !!---------------------------------------------------------------------- 
    120 CONTAINS 
    121    SUBROUTINE trc_nam_cfc                      ! Empty routine 
    122    END  SUBROUTINE  trc_nam_cfc 
    123 #endif   
    124  
    125106   !!====================================================================== 
    126107END MODULE trcnam_cfc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6140 r7646  
    77   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity 
    88   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_cfc 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_cfc'                                               CFC tracers 
     9   !!            4.0  !  2016-11  (T. Lovato) Add SF6, Update Schmidt number 
    1310   !!---------------------------------------------------------------------- 
    1411   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
     
    2926 
    3027   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    31    INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
     28   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc) 
    3229   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    3330   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3431   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
    3532    
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for all CFC 
    3734   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm 
    3835   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
    3936   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC 
    4038   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4139 
    42    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    43    REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
    45        
     40   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm] 
     41   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               " 
     42   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius 
    4643   !                          ! coefficients for conversion 
    4744   REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
     
    7976      INTEGER  ::   im1, im2, ierr 
    8077      REAL(wp) ::   ztap, zdtap         
    81       REAL(wp) ::   zt1, zt2, zt3, zv2 
     78      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8279      REAL(wp) ::   zsol      ! solubility 
    8380      REAL(wp) ::   zsch      ! schmidt number  
     
    117114         ! time interpolation at time kt 
    118115         DO jm = 1, jphem 
    119             zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  & 
    120                &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 
     116            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  & 
     117               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. 
    121118         END DO 
    122119          
     
    145142   
    146143               ! Computation of speed transfert 
    147                !    Schmidt number 
     144               !    Schmidt number revised in Wanninkhof (2014) 
    148145               zt1  = tsn(ji,jj,1,jp_tem) 
    149146               zt2  = zt1 * zt1  
    150147               zt3  = zt1 * zt2 
    151                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
    152  
    153                !    speed transfert : formulae of wanninkhof 1992 
     148               zt4  = zt2 * zt2 
     149               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     150 
     151               !    speed transfert : formulae revised in Wanninkhof (2014) 
    154152               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    155153               zsch    = zsch / 660. 
    156                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     154               zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    157155 
    158156               ! Input function  : speed *( conc. at equil - concen at surface ) 
    159157               ! trn in pico-mol/l idem qtr; ak in en m/a 
    160158               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    161 #if defined key_degrad 
    162                   &                         * facvol(ji,jj,1)                           & 
    163 #endif 
    164159                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    165160               ! Add the surface flux to the trend 
     
    185180      ! 
    186181      IF( lk_iomput ) THEN 
    187          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    188          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    189       ELSE 
    190          IF( ln_diatrc ) THEN 
    191             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    192             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    193          END IF 
     182         DO jn = jp_cfc0, jp_cfc1 
     183            CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) ) 
     184            CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     185         ENDDO 
    194186      END IF 
    195187      ! 
     
    212204      !!--------------------------------------------------------------------- 
    213205      INTEGER :: jn 
    214  
     206      !!---------------------------------------------------------------------- 
     207      ! 
     208      jn = 0  
    215209      ! coefficient for CFC11  
    216210      !---------------------- 
    217  
    218       ! Solubility 
    219       soa(1,1) = -229.9261  
    220       soa(2,1) =  319.6552 
    221       soa(3,1) =  119.4471 
    222       soa(4,1) =  -1.39165 
    223  
    224       sob(1,1) =  -0.142382 
    225       sob(2,1) =   0.091459 
    226       sob(3,1) =  -0.0157274 
    227  
    228       ! Schmidt number  
    229       sca(1,1) = 3501.8 
    230       sca(2,1) = -210.31 
    231       sca(3,1) =  6.1851 
    232       sca(4,1) = -0.07513 
     211      if ( ln_cfc11 ) then 
     212         jn = jn + 1 
     213         ! Solubility 
     214         soa(1,jn) = -229.9261  
     215         soa(2,jn) =  319.6552 
     216         soa(3,jn) =  119.4471 
     217         soa(4,jn) =  -1.39165 
     218 
     219         sob(1,jn) =  -0.142382 
     220         sob(2,jn) =   0.091459 
     221         sob(3,jn) =  -0.0157274 
     222 
     223         ! Schmidt number  
     224         sca(1,jn) = 3579.2 
     225         sca(2,jn) = -222.63 
     226         sca(3,jn) = 7.5749 
     227         sca(4,jn) = -0.14595 
     228         sca(5,jn) = 0.0011874 
     229 
     230         ! atm. concentration 
     231         atm_cfc(:,:,jn) = p_cfc(:,:,1) 
     232      endif 
    233233 
    234234      ! coefficient for CFC12  
    235235      !---------------------- 
    236  
    237       ! Solubility 
    238       soa(1,2) = -218.0971 
    239       soa(2,2) =  298.9702 
    240       soa(3,2) =  113.8049 
    241       soa(4,2) =  -1.39165 
    242  
    243       sob(1,2) =  -0.143566 
    244       sob(2,2) =   0.091015 
    245       sob(3,2) =  -0.0153924 
    246  
    247       ! schmidt number  
    248       sca(1,2) =  3845.4  
    249       sca(2,2) =  -228.95 
    250       sca(3,2) =  6.1908  
    251       sca(4,2) =  -0.067430 
     236      if ( ln_cfc12 ) then 
     237         jn = jn + 1 
     238         ! Solubility 
     239         soa(1,jn) = -218.0971 
     240         soa(2,jn) =  298.9702 
     241         soa(3,jn) =  113.8049 
     242         soa(4,jn) =  -1.39165 
     243 
     244         sob(1,jn) =  -0.143566 
     245         sob(2,jn) =   0.091015 
     246         sob(3,jn) =  -0.0153924 
     247 
     248         ! schmidt number  
     249         sca(1,jn) = 3828.1 
     250         sca(2,jn) = -249.86 
     251         sca(3,jn) = 8.7603 
     252         sca(4,jn) = -0.1716 
     253         sca(5,jn) = 0.001408 
     254 
     255         ! atm. concentration 
     256         atm_cfc(:,:,jn) = p_cfc(:,:,2) 
     257      endif 
     258 
     259      ! coefficient for SF6 
     260      !---------------------- 
     261      if ( ln_sf6 ) then 
     262         jn = jn + 1 
     263         ! Solubility 
     264         soa(1,jn) = -80.0343 
     265         soa(2,jn) = 117.232 
     266         soa(3,jn) =  29.5817 
     267         soa(4,jn) =   0.0 
     268 
     269         sob(1,jn) =  0.0335183  
     270         sob(2,jn) = -0.0373942  
     271         sob(3,jn) =  0.00774862 
     272 
     273         ! schmidt number 
     274         sca(1,jn) = 3177.5 
     275         sca(2,jn) = -200.57 
     276         sca(3,jn) = 6.8865 
     277         sca(4,jn) = -0.13335 
     278         sca(5,jn) = 0.0010877 
     279   
     280         ! atm. concentration 
     281         atm_cfc(:,:,jn) = p_cfc(:,:,3) 
     282       endif 
    252283 
    253284      IF( ln_rsttr ) THEN 
     
    269300      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    270301      !!---------------------------------------------------------------------- 
    271       ALLOCATE( xphem   (jpi,jpj)        ,     & 
    272          &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
    273          &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     302      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    & 
     303         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    & 
     304         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    & 
     305         &      STAT=trc_sms_cfc_alloc ) 
    274306         ! 
    275307      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
     
    277309   END FUNCTION trc_sms_cfc_alloc 
    278310 
    279 #else 
    280    !!---------------------------------------------------------------------- 
    281    !!   Dummy module                                         No CFC tracers 
    282    !!---------------------------------------------------------------------- 
    283 CONTAINS 
    284    SUBROUTINE trc_sms_cfc( kt )       ! Empty routine 
    285       WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt 
    286    END SUBROUTINE trc_sms_cfc 
    287 #endif 
    288  
    289311   !!====================================================================== 
    290312END MODULE trcsms_cfc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90

    r5836 r7646  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && defined key_cfc && defined key_iomput 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                           cfc model 
     8#if defined key_top && defined key_iomput 
    119   !!---------------------------------------------------------------------- 
    1210   !! trc_wri_cfc   :  outputs of concentration fields 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r3680 r7646  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    13    USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    14    USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES 
    15    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    16  
    17    USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC 
    18    USE par_cfc    , ONLY : jp_cfc_2d       !: number of tracers in CFC 
    19    USE par_cfc    , ONLY : jp_cfc_3d       !: number of tracers in CFC 
    20    USE par_cfc    , ONLY : jp_cfc_trd      !: number of tracers in CFC 
    21  
    22    USE par_c14b   , ONLY : jp_c14b         !: number of tracers in C14 
    23    USE par_c14b   , ONLY : jp_c14b_2d      !: number of tracers in C14 
    24    USE par_c14b   , ONLY : jp_c14b_3d      !: number of tracers in C14 
    25    USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14 
    2612 
    2713   IMPLICIT NONE 
    2814 
    29    INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     !:  
    30    INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    31    INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    32    INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
    33  
    34 #if defined key_my_trc 
    35    !!--------------------------------------------------------------------- 
    36    !!   'key_my_trc'                     user defined tracers (MY_TRC) 
    37    !!--------------------------------------------------------------------- 
    38    LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .TRUE.   !: PTS flag  
    39    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  1       !: number of PTS tracers 
    40    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd') 
    41    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd') 
    42    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC 
    43  
    44    ! assign an index in trc arrays for each PTS prognostic variables 
    45    INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer 
    46  
    47 #else 
    48    !!--------------------------------------------------------------------- 
    49    !!   Default                           No user defined tracers (MY_TRC) 
    50    !!--------------------------------------------------------------------- 
    51    LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .FALSE.  !: MY_TRC flag  
    52    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  0       !: No MY_TRC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: No MY_TRC additional 2d output arrays  
    54    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: No MY_TRC additional 3d output arrays  
    55    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC 
    56 #endif 
    57  
    5815   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    59    INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lm     + 1              !: First index of MY_TRC passive tracers 
    60    INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lm     + jp_my_trc      !: Last  index of MY_TRC passive tracers 
    61    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lm_2d  + 1              !: First index of MY_TRC passive tracers 
    62    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lm_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers 
    63    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lm_3d  + 1              !: First index of MY_TRC passive tracers 
    64    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lm_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers 
    65    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lm_trd + 1              !: First index of MY_TRC passive tracers 
    66    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lm_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers 
    67  
     16   INTEGER, PUBLIC ::   jp_myt0             !: First index of MY_TRC passive tracers 
     17   INTEGER, PUBLIC ::   jp_myt1             !: Last  index of MY_TRC passive tracers 
    6818   !!====================================================================== 
    6919END MODULE par_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90

    r5439 r7646  
    33   !!                         ***  MODULE trcice_my_trc  *** 
    44   !!---------------------------------------------------------------------- 
    5 #if defined key_my_trc 
     5   !! trc_ice_my_trc       : MY_TRC model seaice coupling routine 
    66   !!---------------------------------------------------------------------- 
    7    !!   'key_my_trc'                                               CFC tracers 
    8    !!---------------------------------------------------------------------- 
    9    !! trc_ice_my_trc       : MY_TRC model main routine 
     7   !! History :        !  2016  (C. Ethe, T. Lovato) Revised architecture 
    108   !!---------------------------------------------------------------------- 
    119   USE par_trc         ! TOP parameters 
     
    1917 
    2018   !!---------------------------------------------------------------------- 
    21    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    22    !! $Id: trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham $ 
     19   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
     20   !! $Id$ 
    2321   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2422   !!---------------------------------------------------------------------- 
     
    3432   END SUBROUTINE trc_ice_ini_my_trc 
    3533 
    36 #else 
    37    !!---------------------------------------------------------------------- 
    38    !!   Dummy module                                        No MY_TRC model 
    39    !!---------------------------------------------------------------------- 
    40 CONTAINS 
    41    SUBROUTINE trc_ice_ini_my_trc             ! Empty routine 
    42    END SUBROUTINE trc_ice_ini_my_trc 
    43 #endif 
    44  
    4534   !!====================================================================== 
    4635END MODULE trcice_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r5385 r7646  
    44   !! TOP :   initialisation of the MY_TRC tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                               CFC tracers 
     6   !! History :        !  2007  (C. Ethe, G. Madec) Original code 
     7   !!                  !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_ini_my_trc   : MY_TRC model initialisation 
     
    1512   USE oce_trc 
    1613   USE trc 
     14   USE par_my_trc 
     15   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    1716   USE trcsms_my_trc 
    1817 
     
    2322 
    2423   !!---------------------------------------------------------------------- 
    25    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     24   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    2625   !! $Id$  
    2726   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    3736      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    3837      !!---------------------------------------------------------------------- 
    39  
     38      ! 
     39      CALL trc_nam_my_trc 
     40      ! 
    4041      !                       ! Allocate MY_TRC arrays 
    4142      IF( trc_sms_my_trc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) 
     
    5354   END SUBROUTINE trc_ini_my_trc 
    5455 
    55 #else 
    56    !!---------------------------------------------------------------------- 
    57    !!   Dummy module                                        No MY_TRC model 
    58    !!---------------------------------------------------------------------- 
    59 CONTAINS 
    60    SUBROUTINE trc_ini_my_trc             ! Empty routine 
    61    END SUBROUTINE trc_ini_my_trc 
    62 #endif 
    63  
    6456   !!====================================================================== 
    6557END MODULE trcini_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90

    r3680 r7646  
    44   !! TOP :   initialisation of some run parameters for MY_TRC bio-model 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'   :                                       MY_TRC model 
     6   !! History :      !  2007  (C. Ethe, G. Madec) Original code 
     7   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_nam_my_trc      : MY_TRC model initialisation 
     
    2219 
    2320   !!---------------------------------------------------------------------- 
    24    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     21   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    2522   !! $Id$  
    2623   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    4340   END SUBROUTINE trc_nam_my_trc 
    4441    
    45 #else 
    46    !!---------------------------------------------------------------------- 
    47    !!  Dummy module :                                             No MY_TRC 
    48    !!---------------------------------------------------------------------- 
    49 CONTAINS 
    50    SUBROUTINE trc_nam_my_trc                      ! Empty routine 
    51    END  SUBROUTINE  trc_nam_my_trc 
    52 #endif   
    53  
    5442   !!====================================================================== 
    5543END MODULE trcnam_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r6140 r7646  
    44   !! TOP :   Main module of the MY_TRC tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                               CFC tracers 
     6   !! History :      !  2007  (C. Ethe, G. Madec)  Original code 
     7   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_sms_my_trc       : MY_TRC model main routine 
     
    1815   USE trd_oce 
    1916   USE trdtrc 
    20    USE trcbc, only : trc_bc_read 
     17   USE trcbc, only : trc_bc 
    2118 
    2219   IMPLICIT NONE 
     
    2926 
    3027   !!---------------------------------------------------------------------- 
    31    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     28   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    3229   !! $Id$ 
    3330   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    5754      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    5855 
    59       CALL trc_bc_read ( kt )       ! tracers: surface and lateral Boundary Conditions 
     56      CALL trc_bc ( kt )       ! tracers: surface and lateral Boundary Conditions 
    6057 
    6158      ! add here the call to BGC model 
     
    7471   END SUBROUTINE trc_sms_my_trc 
    7572 
    76  
    7773   INTEGER FUNCTION trc_sms_my_trc_alloc() 
    7874      !!---------------------------------------------------------------------- 
     
    8884   END FUNCTION trc_sms_my_trc_alloc 
    8985 
    90  
    91 #else 
    92    !!---------------------------------------------------------------------- 
    93    !!   Dummy module                                        No MY_TRC model 
    94    !!---------------------------------------------------------------------- 
    95 CONTAINS 
    96    SUBROUTINE trc_sms_my_trc( kt )             ! Empty routine 
    97       INTEGER, INTENT( in ) ::   kt 
    98       WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt 
    99    END SUBROUTINE trc_sms_my_trc 
    100 #endif 
    101  
    10286   !!====================================================================== 
    10387END MODULE trcsms_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r6140 r7646  
    22   !!====================================================================== 
    33   !!                       *** MODULE trcwri *** 
    4    !!    my_trc :   Output of my_trc tracers 
     4   !!     trc_wri_my_trc   :  outputs of concentration fields 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     6#if defined key_top && defined key_iomput 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && defined key_my_trc && defined key_iomput 
     8   !! History :      !  2007  (C. Ethe, G. Madec)  Original code 
     9   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    910   !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                           my_trc model 
    11    !!---------------------------------------------------------------------- 
    12    !! trc_wri_my_trc   :  outputs of concentration fields 
    13    !!---------------------------------------------------------------------- 
     11   USE par_trc         ! passive tracers common variables 
    1412   USE trc         ! passive tracers common variables  
    1513   USE iom         ! I/O manager 
     
    2018   PUBLIC trc_wri_my_trc  
    2119 
     20   !!---------------------------------------------------------------------- 
     21   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
     22   !! $Id$ 
     23   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     24   !!---------------------------------------------------------------------- 
    2225CONTAINS 
    2326 
     
    3639      DO jn = jp_myt0, jp_myt1 
    3740         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    38          IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) ) 
     41         CALL iom_put( cltra, trn(:,:,:,jn) ) 
    3942      END DO 
    4043      ! 
     
    4245 
    4346#else 
    44    !!---------------------------------------------------------------------- 
    45    !!  Dummy module :                                     No passive tracer 
    46    !!---------------------------------------------------------------------- 
    47    PUBLIC trc_wri_my_trc 
     47 
    4848CONTAINS 
    49    SUBROUTINE trc_wri_my_trc                     ! Empty routine   
     49 
     50   SUBROUTINE trc_wri_my_trc 
     51      ! 
    5052   END SUBROUTINE trc_wri_my_trc 
     53 
    5154#endif 
    5255 
    53    !!---------------------------------------------------------------------- 
    54    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    55    !! $Id: trcwri_my_trc.F90 3160 2011-11-20 14:27:18Z cetlod $  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!====================================================================== 
    5856END MODULE trcwri_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r6140 r7646  
    88   !!              -   !  2001-03  (M. Levy)  LNO3 + dia2d  
    99   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
    10    !!---------------------------------------------------------------------- 
    11 #if defined key_pisces_reduced 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    1410   !!---------------------------------------------------------------------- 
    1511   !!   p2z_bio        :   
     
    8682      !!                                  source      sink 
    8783      !!         
    88       !!              IF 'key_diabio' defined , the biogeochemical trends 
    89       !!              for passive tracers are saved for futher diagnostics. 
    9084      !!--------------------------------------------------------------------- 
    9185      !! 
     
    109103      IF( nn_timing == 1 )  CALL timing_start('p2z_bio') 
    110104      ! 
    111       IF( ln_diatrc .OR. lk_iomput ) THEN 
     105      IF( lk_iomput ) THEN 
    112106         CALL wrk_alloc( jpi, jpj,     17, zw2d ) 
    113107         CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) 
     
    121115 
    122116      xksi(:,:) = 0.e0        ! zooplakton closure ( fbod) 
    123       IF( ln_diatrc .OR. lk_iomput ) THEN 
     117      IF( lk_iomput ) THEN 
    124118         zw2d  (:,:,:) = 0.e0 
    125119         zw3d(:,:,:,:) = 0.e0 
     
    218212               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    219213 
    220  
    221                IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    222                   trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy 
    223                   trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy 
    224                   trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4 
    225                   trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom 
    226                   trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo 
    227                   trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet 
    228                   trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo 
    229                   !  trend number 8 in p2zsed 
    230                   trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet 
    231                   trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod 
    232                   trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 
    233                   trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 
    234                   trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 
    235                   trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 
    236                   trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 
    237                   trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 
    238                   !  trend number 17 in p2zexp 
    239                 ENDIF 
    240                 IF( ln_diatrc .OR. lk_iomput ) THEN 
     214                IF( lk_iomput ) THEN 
    241215                  ! convert fluxes in per day 
    242216                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
     
    340314               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    341315               ! 
    342                IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    343                   trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy 
    344                   trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy 
    345                   trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4 
    346                   trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom 
    347                   trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo 
    348                   trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet 
    349                   trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo 
    350                   !  trend number 8 in p2zsed 
    351                   trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet 
    352                   trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod 
    353                   trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 
    354                   trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 
    355                   trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 
    356                   trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 
    357                   trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 
    358                   trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 
    359                   !  trend number 17 in p2zexp  
    360                 ENDIF 
    361                 IF( ln_diatrc .OR. lk_iomput ) THEN 
     316                IF( lk_iomput ) THEN 
    362317                  ! convert fluxes in per day 
    363318                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
     
    389344      END DO 
    390345 
    391       IF( ln_diatrc .OR. lk_iomput ) THEN 
     346      IF( lk_iomput ) THEN 
    392347         DO jl = 1, 17  
    393348            CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
     
    420375        CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
    421376         ! 
    422        ELSE 
    423           IF( ln_diatrc ) THEN 
    424             ! 
    425             trc2d(:,:,jp_pcs0_2d    ) = zw2d(:,:,1)  
    426             trc2d(:,:,jp_pcs0_2d + 1) = zw2d(:,:,2)  
    427             trc2d(:,:,jp_pcs0_2d + 2) = zw2d(:,:,3)  
    428             trc2d(:,:,jp_pcs0_2d + 3) = zw2d(:,:,4)  
    429             trc2d(:,:,jp_pcs0_2d + 4) = zw2d(:,:,5)  
    430             trc2d(:,:,jp_pcs0_2d + 5) = zw2d(:,:,6)  
    431             trc2d(:,:,jp_pcs0_2d + 6) = zw2d(:,:,7)  
    432                      ! trend number 8 is in p2zsed.F 
    433             trc2d(:,:,jp_pcs0_2d +  8) = zw2d(:,:,8)  
    434             trc2d(:,:,jp_pcs0_2d +  9) = zw2d(:,:,9)  
    435             trc2d(:,:,jp_pcs0_2d + 10) = zw2d(:,:,10)  
    436             trc2d(:,:,jp_pcs0_2d + 11) = zw2d(:,:,11)  
    437             trc2d(:,:,jp_pcs0_2d + 12) = zw2d(:,:,12)  
    438             trc2d(:,:,jp_pcs0_2d + 13) = zw2d(:,:,13)  
    439             trc2d(:,:,jp_pcs0_2d + 14) = zw2d(:,:,14)  
    440             trc2d(:,:,jp_pcs0_2d + 15) = zw2d(:,:,15)  
    441             trc2d(:,:,jp_pcs0_2d + 16) = zw2d(:,:,16)  
    442             trc2d(:,:,jp_pcs0_2d + 17) = zw2d(:,:,17)  
    443             ! trend number 19 is in p2zexp.F 
    444             trc3d(:,:,:,jp_pcs0_3d    ) = zw3d(:,:,:,1)  
    445             trc3d(:,:,:,jp_pcs0_3d + 1) = zw3d(:,:,:,2)  
    446             trc3d(:,:,:,jp_pcs0_3d + 2) = zw3d(:,:,:,3)  
    447          ENDIF 
    448         ! 
    449       ENDIF 
    450  
    451       IF( ln_diabio .AND. .NOT. lk_iomput )  THEN 
    452          DO jl = jp_pcs0_trd, jp_pcs1_trd 
    453             CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 
    454          END DO  
    455       ENDIF 
    456       ! 
    457       IF( l_trdtrc ) THEN 
    458          DO jl = jp_pcs0_trd, jp_pcs1_trd 
    459             CALL trd_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
    460          END DO 
    461377      ENDIF 
    462378 
     
    467383      ENDIF 
    468384      ! 
    469       IF( ln_diatrc .OR. lk_iomput ) THEN 
     385      IF( lk_iomput ) THEN 
    470386         CALL wrk_dealloc( jpi, jpj,     17, zw2d ) 
    471387         CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) 
     
    586502   END SUBROUTINE p2z_bio_init 
    587503 
    588 #else 
    589    !!====================================================================== 
    590    !!  Dummy module :                                   No PISCES bio-model 
    591    !!====================================================================== 
    592 CONTAINS 
    593    SUBROUTINE p2z_bio( kt )                   ! Empty routine 
    594       INTEGER, INTENT( in ) ::   kt 
    595       WRITE(*,*) 'p2z_bio: You should not have seen this print! error?', kt 
    596    END SUBROUTINE p2z_bio 
    597 #endif  
    598  
    599504   !!====================================================================== 
    600505END MODULE p2zbio 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r6140 r7646  
    1010   !!             3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER 
    1111   !!---------------------------------------------------------------------- 
    12 #if defined key_pisces_reduced 
    13    !!---------------------------------------------------------------------- 
    14    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    15    !!---------------------------------------------------------------------- 
    1612   !!   p2z_exp        :  Compute loss of organic matter in the sediments 
    1713   !!---------------------------------------------------------------------- 
     
    6864      INTEGER  ::   ji, jj, jk, jl, ikt 
    6965      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 
    70       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrbio 
    7166      REAL(wp), POINTER, DIMENSION(:,:)   ::  zsedpoca 
    7267      CHARACTER (len=25) :: charout 
     
    8075      zsedpoca(:,:) = 0. 
    8176 
    82       IF( l_trdtrc )  THEN 
    83          CALL wrk_alloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends 
    84          ztrbio(:,:,:) = tra(:,:,:,jpno3) 
    85       ENDIF 
    8677 
    8778      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 
     
    126117  
    127118      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    128       IF( lk_iomput ) THEN   
    129          CALL iom_put( "SEDPOC" , sedpocn ) 
    130       ELSE 
    131          IF( ln_diatrc )           trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:) 
    132       ENDIF 
     119      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn ) 
    133120 
    134121       
     
    160147      ENDIF 
    161148      ! 
    162       IF( l_trdtrc ) THEN 
    163          ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 
    164          jl = jp_pcs0_trd + 16 
    165          CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    166          CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends 
    167       ENDIF 
    168       ! 
    169149      CALL wrk_dealloc( jpi, jpj, zsedpoca)   ! temporary save of trends 
    170150 
     
    281261   END FUNCTION p2z_exp_alloc 
    282262 
    283 #else 
    284    !!====================================================================== 
    285    !!  Dummy module :                                   No PISCES bio-model 
    286    !!====================================================================== 
    287 CONTAINS 
    288    SUBROUTINE p2z_exp( kt )                   ! Empty routine 
    289       INTEGER, INTENT( in ) ::   kt 
    290       WRITE(*,*) 'p2z_exp: You should not have seen this print! error?', kt 
    291    END SUBROUTINE p2z_exp 
    292 #endif  
    293  
    294263   !!====================================================================== 
    295264END MODULE  p2zexp 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r6140 r7646  
    1010   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
    1111   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style 
    12    !!---------------------------------------------------------------------- 
    13 #if defined key_pisces_reduced 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    1612   !!---------------------------------------------------------------------- 
    1713   !!   p2z_opt        :   Compute the light availability in the water column 
     
    208204   END SUBROUTINE p2z_opt_init 
    209205 
    210 #else 
    211    !!====================================================================== 
    212    !!  Dummy module :                                   No PISCES bio-model 
    213    !!====================================================================== 
    214 CONTAINS 
    215    SUBROUTINE p2z_opt( kt )                   ! Empty routine 
    216       INTEGER, INTENT( in ) ::   kt 
    217       WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt 
    218    END SUBROUTINE p2z_opt 
    219 #endif  
    220  
    221206   !!====================================================================== 
    222207END MODULE  p2zopt 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r6140 r7646  
    77   !!              -   !  2000-12 (E. Kestenare)  clean up 
    88   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_pisces_reduced 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    139   !!---------------------------------------------------------------------- 
    1410   !!   p2z_sed        :  Compute loss of organic matter in the sediments 
     
    6662      CHARACTER (len=25) :: charout 
    6763      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    68       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra 
    6965      !!--------------------------------------------------------------------- 
    7066      ! 
     
    7975      ! Allocate temporary workspace 
    8076      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra ) 
    81       IF( l_trdtrc ) THEN 
    82          CALL wrk_alloc( jpi, jpj, jpk, ztrbio ) 
    83          ztrbio(:,:,:) = tra(:,:,:,jpdet) 
    84       ENDIF 
    8577 
    8678      ! sedimentation of detritus  : upstream scheme 
     
    116108            CALL wrk_dealloc( jpi, jpj, zw2d ) 
    117109         ENDIF 
    118       ELSE 
    119          IF( ln_diatrc ) THEN  
    120             CALL wrk_alloc( jpi, jpj, zw2d ) 
    121             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    122             DO jk = 2, jpkm1 
    123                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    124             END DO 
    125             trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 
    126             CALL wrk_dealloc( jpi, jpj, zw2d ) 
    127          ENDIF 
    128110      ENDIF 
    129111      ! 
    130       IF( ln_diabio .AND. .NOT. lk_iomput )  trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:) 
    131112      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra ) 
    132113      ! 
    133       IF( l_trdtrc ) THEN 
    134          ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 
    135          jl = jp_pcs0_trd + 7 
    136          CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    137          CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 
    138       ENDIF 
    139114 
    140115      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    180155   END SUBROUTINE p2z_sed_init 
    181156 
    182 #else 
    183    !!====================================================================== 
    184    !!  Dummy module :                                   No PISCES bio-model 
    185    !!====================================================================== 
    186 CONTAINS 
    187    SUBROUTINE p2z_sed( kt )                   ! Empty routine 
    188       INTEGER, INTENT( in ) ::   kt 
    189       WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt 
    190    END SUBROUTINE p2z_sed 
    191 #endif  
    192  
    193157   !!====================================================================== 
    194158END MODULE  p2zsed 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r5656 r7646  
    66   !! History :   1.0  !            M. Levy 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces_reduced 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces_reduced'                              LOBSTER bio-model 
    128   !!---------------------------------------------------------------------- 
    139   !!   p2zsms        :  Time loop of passive tracers sms 
     
    7268   END SUBROUTINE p2z_sms 
    7369 
    74 #else 
    75    !!====================================================================== 
    76    !!  Dummy module :                                     No passive tracer 
    77    !!====================================================================== 
    78 CONTAINS 
    79    SUBROUTINE p2z_sms( kt )                   ! Empty routine 
    80       INTEGER, INTENT( in ) ::   kt 
    81       WRITE(*,*) 'p2z_sms: You should not have seen this print! error?', kt 
    82    END SUBROUTINE p2z_sms 
    83 #endif  
    84  
    8570   !!====================================================================== 
    8671END MODULE p2zsms 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r6140 r7646  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    128   !!---------------------------------------------------------------------- 
    139   !!   p4z_bio        :   computes the interactions between the different 
     
    2420   USE p4zmicro        !  Sources and sinks of microzooplankton 
    2521   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     22   USE p5zlim          !  Co-limitations of differents nutrients 
     23   USE p5zprod         !  Growth rate of the 2 phyto groups 
     24   USE p5zmort         !  Mortality terms for phytoplankton 
     25   USE p5zmicro        !  Sources and sinks of microzooplankton 
     26   USE p5zmeso         !  Sources and sinks of mesozooplankton 
    2627   USE p4zrem          !  Remineralisation of organic matter 
     28   USE p4zpoc          !  Remineralization of organic particles 
     29   USE p4zagg          !  Aggregation of particles 
    2730   USE p4zfechem 
     31   USE p4zligand       !  Prognostic ligand model 
    2832   USE prtctl_trc      !  print control for debugging 
    2933   USE iom             !  I/O manager 
     
    7377      END DO 
    7478 
    75       CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column 
    76       CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter 
    77       CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging 
    78       CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    79       CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    80       !                             ! (for each element : C, Si, Fe, Chl ) 
    81       CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    82      !                             ! zooplankton sources/sinks routines  
    83       CALL p4z_micro( kt, knt )           ! microzooplankton 
    84       CALL p4z_meso ( kt, knt )           ! mesozooplankton 
    85       CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
    86       !                             ! test if tracers concentrations fall below 0. 
     79      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column 
     80      CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter 
     81      CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging 
     82      ! 
     83      IF( ln_p4z ) THEN 
     84         CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
     85         CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
     86         !                             ! (for each element : C, Si, Fe, Chl ) 
     87         CALL p4z_mort ( kt      )     ! phytoplankton mortality 
     88         !                             ! zooplankton sources/sinks routines  
     89         CALL p4z_micro( kt, knt )           ! microzooplankton 
     90         CALL p4z_meso ( kt, knt )           ! mesozooplankton 
     91      ELSE 
     92         CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
     93         CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
     94         !                             ! (for each element : C, Si, Fe, Chl ) 
     95         CALL p5z_mort ( kt      )     ! phytoplankton mortality 
     96         !                             ! zooplankton sources/sinks routines  
     97         CALL p5z_micro( kt, knt )           ! microzooplankton 
     98         CALL p5z_meso ( kt, knt )           ! mesozooplankton 
     99      ENDIF 
     100      ! 
     101      CALL p4z_agg  ( kt, knt )     ! Aggregation of particles 
     102      CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
     103      CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles 
     104      IF( ln_ligand ) THEN 
     105        CALL p4z_ligand( kt, knt ) 
     106      ENDIF 
    87107      !                                                             ! 
    88108      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    96116   END SUBROUTINE p4z_bio 
    97117 
    98 #else 
    99    !!====================================================================== 
    100    !!  Dummy module :                                   No PISCES bio-model 
    101    !!====================================================================== 
    102 CONTAINS 
    103    SUBROUTINE p4z_bio                         ! Empty routine 
    104    END SUBROUTINE p4z_bio 
    105 #endif  
    106  
    107118   !!====================================================================== 
    108119END MODULE p4zbio 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r6945 r7646  
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    1212   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants 
    13    !!---------------------------------------------------------------------- 
    14 #if defined key_pisces 
    15    !!---------------------------------------------------------------------- 
    16    !!   'key_pisces'                                       PISCES bio-model 
     13   !!             3.6  !  2016-03  (O. Aumont) Change chemistry to MOCSY standards 
    1714   !!---------------------------------------------------------------------- 
    1815   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
     
    2219   USE sms_pisces    !  PISCES Source Minus Sink variables 
    2320   USE lib_mpp       !  MPP library 
     21   USE eosbn2, ONLY : neos 
    2422 
    2523   IMPLICIT NONE 
    2624   PRIVATE 
    2725 
    28    PUBLIC   p4z_che         ! 
    29    PUBLIC   p4z_che_alloc   ! 
    30  
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2   ! Solubilities of O2 and CO2 
     26   PUBLIC   p4z_che          ! 
     27   PUBLIC   p4z_che_alloc    ! 
     28   PUBLIC   ahini_for_at     ! 
     29   PUBLIC   solve_at_general ! 
     30 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: sio3eq   ! chemistry of Si 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: fekeq    ! chemistry of Fe 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemc    ! Solubilities of O2 and CO2 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemo2    ! Solubilities of O2 and CO2 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol    ! solubility of Fe 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   salinprac  ! Practical salinity 
    3537   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature 
    3638 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ??? 
     42   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ??? 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ??? 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ??? 
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ??? 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ??? 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ??? 
     49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ??? 
     50 
     51   !!* Variable for chemistry of the CO2 cycle 
     52 
    3753   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm 
    3854 
    39    REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    4055   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )   
    4156 
    42    REAL(wp) ::   rgas   = 83.14472       ! universal gas constants 
    43    REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles 
    44  
    45    REAL(wp) ::   bor1   = 0.00023        ! borat constants 
    46    REAL(wp) ::   bor2   = 1. / 10.82 
    47  
    48    REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate 
    49    REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966) 
    50  
    51    REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides 
    52    REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 ) 
    53  
    54    !                                    ! volumetric solubility constants for o2 in ml/L   
    55    REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 
    56    REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure 
    57    REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but  
    58    REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 
    59    REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 
    60    REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension. 
    61    REAL(wp) ::   ox6    = -6.24097e-3    
    62    REAL(wp) ::   ox7    = -6.93498e-3  
    63    REAL(wp) ::   ox8    = -6.90358e-3 
    64    REAL(wp) ::   ox9    = -4.29155e-3  
    65    REAL(wp) ::   ox10   = -3.11680e-7  
    66  
     57   REAL(wp) ::   rgas   = 83.14472      ! universal gas constants 
     58   REAL(wp) ::   oxyco  = 1. / 22.4144  ! converts from liters of an ideal gas to moles 
    6759   !                                    ! coeff. for seawater pressure correction : millero 95 
    6860   !                                    ! AGRIF doesn't like the DATA instruction 
    69    REAL(wp) :: devk11  = -25.5 
    70    REAL(wp) :: devk12  = -15.82 
    71    REAL(wp) :: devk13  = -29.48 
    72    REAL(wp) :: devk14  = -25.60 
    73    REAL(wp) :: devk15  = -48.76 
     61   REAL(wp) :: devk10  = -25.5 
     62   REAL(wp) :: devk11  = -15.82 
     63   REAL(wp) :: devk12  = -29.48 
     64   REAL(wp) :: devk13  = -20.02 
     65   REAL(wp) :: devk14  = -18.03 
     66   REAL(wp) :: devk15  = -9.78 
     67   REAL(wp) :: devk16  = -48.76 
     68   REAL(wp) :: devk17  = -14.51 
     69   REAL(wp) :: devk18  = -23.12 
     70   REAL(wp) :: devk19  = -26.57 
     71   REAL(wp) :: devk110  = -29.48 
    7472   ! 
    75    REAL(wp) :: devk21  = 0.1271 
    76    REAL(wp) :: devk22  = -0.0219 
    77    REAL(wp) :: devk23  = 0.1622 
    78    REAL(wp) :: devk24  = 0.2324 
    79    REAL(wp) :: devk25  = 0.5304 
     73   REAL(wp) :: devk20  = 0.1271 
     74   REAL(wp) :: devk21  = -0.0219 
     75   REAL(wp) :: devk22  = 0.1622 
     76   REAL(wp) :: devk23  = 0.1119 
     77   REAL(wp) :: devk24  = 0.0466 
     78   REAL(wp) :: devk25  = -0.0090 
     79   REAL(wp) :: devk26  = 0.5304 
     80   REAL(wp) :: devk27  = 0.1211 
     81   REAL(wp) :: devk28  = 0.1758 
     82   REAL(wp) :: devk29  = 0.2020 
     83   REAL(wp) :: devk210  = 0.1622 
    8084   ! 
     85   REAL(wp) :: devk30  = 0. 
    8186   REAL(wp) :: devk31  = 0. 
    82    REAL(wp) :: devk32  = 0. 
    83    REAL(wp) :: devk33  = 2.608E-3 
    84    REAL(wp) :: devk34  = -3.6246E-3 
    85    REAL(wp) :: devk35  = 0. 
     87   REAL(wp) :: devk32  = 2.608E-3 
     88   REAL(wp) :: devk33  = -1.409e-3 
     89   REAL(wp) :: devk34  = 0.316e-3 
     90   REAL(wp) :: devk35  = -0.942e-3 
     91   REAL(wp) :: devk36  = 0. 
     92   REAL(wp) :: devk37  = -0.321e-3 
     93   REAL(wp) :: devk38  = -2.647e-3 
     94   REAL(wp) :: devk39  = -3.042e-3 
     95   REAL(wp) :: devk310  = -2.6080e-3 
    8696   ! 
    87    REAL(wp) :: devk41  = -3.08E-3 
    88    REAL(wp) :: devk42  = 1.13E-3 
    89    REAL(wp) :: devk43  = -2.84E-3 
    90    REAL(wp) :: devk44  = -5.13E-3 
    91    REAL(wp) :: devk45  = -11.76E-3 
     97   REAL(wp) :: devk40  = -3.08E-3 
     98   REAL(wp) :: devk41  = 1.13E-3 
     99   REAL(wp) :: devk42  = -2.84E-3 
     100   REAL(wp) :: devk43  = -5.13E-3 
     101   REAL(wp) :: devk44  = -4.53e-3 
     102   REAL(wp) :: devk45  = -3.91e-3 
     103   REAL(wp) :: devk46  = -11.76e-3 
     104   REAL(wp) :: devk47  = -2.67e-3 
     105   REAL(wp) :: devk48  = -5.15e-3 
     106   REAL(wp) :: devk49  = -4.08e-3 
     107   REAL(wp) :: devk410  = -2.84e-3 
    92108   ! 
    93    REAL(wp) :: devk51  = 0.0877E-3 
    94    REAL(wp) :: devk52  = -0.1475E-3      
    95    REAL(wp) :: devk53  = 0. 
    96    REAL(wp) :: devk54  = 0.0794E-3       
    97    REAL(wp) :: devk55  = 0.3692E-3       
     109   REAL(wp) :: devk50  = 0.0877E-3 
     110   REAL(wp) :: devk51  = -0.1475E-3      
     111   REAL(wp) :: devk52  = 0. 
     112   REAL(wp) :: devk53  = 0.0794E-3       
     113   REAL(wp) :: devk54  = 0.09e-3 
     114   REAL(wp) :: devk55  = 0.054e-3 
     115   REAL(wp) :: devk56  = 0.3692E-3 
     116   REAL(wp) :: devk57  = 0.0427e-3 
     117   REAL(wp) :: devk58  = 0.09e-3 
     118   REAL(wp) :: devk59  = 0.0714e-3 
     119   REAL(wp) :: devk510  = 0.0 
     120   ! 
     121   ! General parameters 
     122   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 
     123   REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp 
     124 
     125   ! Maximum number of iterations for each method 
     126   INTEGER, PARAMETER :: jp_maxniter_atgen    = 20 
     127 
     128   ! Bookkeeping variables for each method 
     129   ! - SOLVE_AT_GENERAL 
     130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    98131 
    99132   !!---------------------------------------------------------------------- 
     
    113146      !!--------------------------------------------------------------------- 
    114147      INTEGER  ::   ji, jj, jk 
    115       REAL(wp) ::   ztkel, zt   , zt2  , zsal  , zsal2 , zbuf1 , zbuf2 
     148      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    116149      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 
    117150      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
    118151      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat 
    119       REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1  , za2 
     152      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1, za2 
    120153      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
     154      REAL(wp) ::   zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 
    121155      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
     156      REAL(wp) ::   total2free, free2SWS, total2SWS, SWS2total 
     157 
    122158      !!--------------------------------------------------------------------- 
    123159      ! 
    124160      IF( nn_timing == 1 )  CALL timing_start('p4z_che') 
     161      ! 
     162      ! Computation of chemical constants require practical salinity 
     163      ! Thus, when TEOS08 is used, absolute salinity is converted to  
     164      ! practical salinity 
     165      ! ------------------------------------------------------------- 
     166      IF (neos == -1) THEN 
     167         salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     168      ELSE 
     169         salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     170      ENDIF 
     171 
    125172      ! 
    126173      ! Computations of chemical constants require in situ temperature 
     
    133180            DO ji = 1, jpi 
    134181               zpres = gdept_n(ji,jj,jk) / 1000. 
    135                za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) ) 
     182               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    136183               za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 
    137184               tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 
     
    142189      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    143190      ! ---------------------------------- 
     191!CDIR NOVERRCHK 
    144192      DO jj = 1, jpj 
     193!CDIR NOVERRCHK 
    145194         DO ji = 1, jpi 
    146195            !                             ! SET ABSOLUTE TEMPERATURE 
    147196            ztkel = tempis(ji,jj,1) + 273.15 
    148197            zt    = ztkel * 0.01 
    149             zt2   = zt * zt 
    150             zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
    151             zsal2 = zsal * zsal 
    152             zlogt = LOG( zt ) 
     198            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    153199            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    154200            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    155201            zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    & 
    156202            &       + 0.0047036e-4*ztkel**2) 
    157             !                             ! SET SOLUBILITIES OF O2 AND CO2  
    158             chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 
     203            chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 
    159204            chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 
    160205            chemc(ji,jj,3) = 57.7 - 0.118*ztkel 
     
    165210      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    166211      ! ------------------------------- 
     212!CDIR NOVERRCHK 
    167213      DO jk = 1, jpk 
     214!CDIR NOVERRCHK 
    168215         DO jj = 1, jpj 
     216!CDIR NOVERRCHK 
    169217            DO ji = 1, jpi 
    170218              ztkel = tempis(ji,jj,jk) + 273.15 
    171               zsal  = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35. 
     219              zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 
    172220              zsal2 = zsal * zsal 
    173221              ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
     
    176224              ztgg4 = ztgg3 * ztgg 
    177225              ztgg5 = ztgg4 * ztgg 
    178               zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   & 
    179                      + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2 
     226 
     227              zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    & 
     228              &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   & 
     229              &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   & 
     230              &       - 3.11680e-7 * zsal2 
    180231              chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm) 
    181232            END DO 
     
    187238      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    188239      ! ------------------------------- 
     240!CDIR NOVERRCHK 
    189241      DO jk = 1, jpk 
     242!CDIR NOVERRCHK 
    190243         DO jj = 1, jpj 
     244!CDIR NOVERRCHK 
    191245            DO ji = 1, jpi 
    192246 
     
    199253               ! SET ABSOLUTE TEMPERATURE 
    200254               ztkel   = tempis(ji,jj,jk) + 273.15 
    201                zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
     255               zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    202256               zsqrt  = SQRT( zsal ) 
    203257               zsal15  = zsqrt * zsal 
     
    210264 
    211265               ! CHLORINITY (WOOSTER ET AL., 1969) 
    212                zcl     = zsal * salchl 
     266               zcl     = zsal / 1.80655 
    213267 
    214268               ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 
    215                zst     = st1 * zcl * st2 
     269               zst     = 0.14 * zcl /96.062 
    216270 
    217271               ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 
    218                zft     = ft1 * zcl * ft2 
     272               zft     = 0.000067 * zcl /18.9984 
    219273 
    220274               ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 
     
    224278               &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         & 
    225279               &         + LOG(1.0 - 0.001005 * zsal)) 
    226                ! 
    227                aphscale(ji,jj,jk) = ( 1. + zst / zcks ) 
    228280 
    229281               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
     
    239291               &      * zlogt + 0.053105*zsqrt*ztkel 
    240292 
    241  
    242293               ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO  
    243294               ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 
     
    247298                  - 0.01781*zsal + 0.0001122*zsal*zsal) 
    248299 
    249                ! PKW (H2O) (DICKSON AND RILEY, 1979) 
    250                zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt    &  
    251                &     + (118.67*ztr - 5.977 + 1.0495 * zlogt)        & 
    252                &     * zsqrt - 0.01615 * zsal 
     300               ! PKW (H2O) (MILLERO, 1995) from composite data 
     301               zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    & 
     302                         - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 
     303 
     304               ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 
     305              zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   & 
     306              &          + (-106.736*ztr + 0.69171) * zsqrt       & 
     307              &          + (-0.65643*ztr - 0.01844) * zsal 
     308 
     309              zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  & 
     310              &          + (-160.340*ztr + 1.3566)*zsqrt          & 
     311              &          + (0.37335*ztr - 0.05778)*zsal 
     312 
     313              zck3p    = -3070.75*ztr - 18.126                    & 
     314              &          + (17.27039*ztr + 2.81197) * zsqrt       & 
     315              &          + (-44.99486*ztr - 0.09984) * zsal  
     316 
     317              ! CONSTANT FOR SILICATE, MILLERO (1995) 
     318              zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   & 
     319              &          + (-458.79*ztr + 3.5913) * zisqrt       & 
     320              &          + (188.74*ztr - 1.5998) * zis           & 
     321              &          + (-12.1652*ztr + 0.07871) * zis2       & 
     322              &          + LOG(1.0 - 0.001005*zsal) 
    253323 
    254324               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
     
    258328                  &      - 0.07711*zsal + 0.0041249*zsal15 
    259329 
     330               ! CONVERT FROM DIFFERENT PH SCALES 
     331               total2free  = 1.0/(1.0 + zst/zcks) 
     332               free2SWS    = 1. + zst/zcks + zft/(zckf*total2free) 
     333               total2SWS   = total2free * free2SWS 
     334               SWS2total   = 1.0 / total2SWS 
     335 
    260336               ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 
    261                zak1    = 10**(zck1) 
    262                zak2    = 10**(zck2) 
    263                zakb    = EXP( zckb  ) 
     337               zak1    = 10**(zck1) * total2SWS 
     338               zak2    = 10**(zck2) * total2SWS 
     339               zakb    = EXP( zckb ) * total2SWS 
    264340               zakw    = EXP( zckw ) 
    265341               zaksp1  = 10**(zaksp0) 
     342               zak1p   = exp( zck1p ) 
     343               zak2p   = exp( zck2p ) 
     344               zak3p   = exp( zck3p ) 
     345               zaksi   = exp( zcksi ) 
     346               zckf    = zckf * total2SWS 
    266347 
    267348               ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
     
    275356               !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 
    276357               !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 
    277                zcpexp  = zpres /(rgas*ztkel) 
    278                zcpexp2 = zpres * zpres/(rgas*ztkel) 
     358               zcpexp  = zpres / (rgas*ztkel) 
     359               zcpexp2 = zpres * zcpexp 
    279360 
    280361               ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 
     
    282363               !        (CF. BROECKER ET AL., 1982) 
    283364 
    284                zbuf1  = -     ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
     365               zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 
     366               zbuf2  = 0.5 * ( devk40 + devk50 * ztc ) 
     367               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     368 
     369               zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
    285370               zbuf2  = 0.5 * ( devk41 + devk51 * ztc ) 
    286                ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     371               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    287372 
    288373               zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 
    289374               zbuf2  = 0.5 * ( devk42 + devk52 * ztc ) 
    290                ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     375               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    291376 
    292377               zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 
    293378               zbuf2  = 0.5 * ( devk43 + devk53 * ztc ) 
    294                akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     379               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    295380 
    296381               zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 
    297382               zbuf2  = 0.5 * ( devk44 + devk54 * ztc ) 
    298                akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    299  
     383               aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     384 
     385               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
     386               zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     387               akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     388 
     389               zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 
     390               zbuf2  = 0.5 * ( devk47 + devk57 * ztc ) 
     391               ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     392 
     393               zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 
     394               zbuf2  = 0.5 * ( devk48 + devk58 * ztc ) 
     395               ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     396 
     397               zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 
     398               zbuf2  = 0.5 * ( devk49 + devk59 * ztc ) 
     399               ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     400 
     401               zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 
     402               zbuf2  = 0.5 * ( devk410 + devk510 * ztc ) 
     403               aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     404 
     405               ! CONVERT FROM DIFFERENT PH SCALES 
     406               total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 
     407               free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 
     408               total2SWS   = total2free * free2SWS 
     409               SWS2total   = 1.0 / total2SWS 
     410 
     411               ! Convert to total scale 
     412               ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total 
     413               ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total 
     414               akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total 
     415               akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total 
     416               ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 
     417               ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 
     418               ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 
     419               aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 
     420               akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free 
    300421 
    301422               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE  
    302423               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
    303424               !        (P. 1285) AND BERNER (1976) 
    304                zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
    305                zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     425               zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 
     426               zbuf2  = 0.5 * ( devk46 + devk56 * ztc ) 
    306427               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    307428 
    308                ! TOTAL BORATE CONCENTR. [MOLES/L] 
    309                borat(ji,jj,jk) = bor1 * zcl * bor2 
     429               ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 
     430               borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 
     431               sulfat(ji,jj,jk) = zst 
     432               fluorid(ji,jj,jk) = zft  
    310433 
    311434               ! Iron and SIO3 saturation concentration from ... 
    312435               sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6 
    313                fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) ) 
    314  
     436               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 
     437 
     438               ! Liu and Millero (1999) only valid 5 - 50 degC 
     439               ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 
     440               fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 
     441               fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 
     442               fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 
     443               fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 
     444               fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 
    315445            END DO 
    316446         END DO 
     
    321451   END SUBROUTINE p4z_che 
    322452 
     453   SUBROUTINE ahini_for_at(p_hini) 
     454      !!--------------------------------------------------------------------- 
     455      !!                     ***  ROUTINE ahini_for_at  *** 
     456      !! 
     457      !! Subroutine returns the root for the 2nd order approximation of the 
     458      !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic  
     459      !! polynomial) around the local minimum, if it exists. 
     460      !! Returns * 1E-03_wp if p_alkcb <= 0 
     461      !!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 
     462      !!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 
     463      !!                    and the 2nd order approximation does not have  
     464      !!                    a solution 
     465      !!--------------------------------------------------------------------- 
     466      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     467      INTEGER  ::   ji, jj, jk 
     468      REAL(wp)  ::  zca1, zba1 
     469      REAL(wp)  ::  zd, zsqrtd, zhmin 
     470      REAL(wp)  ::  za2, za1, za0 
     471      REAL(wp)  ::  p_dictot, p_bortot, p_alkcb  
     472 
     473      IF( nn_timing == 1 )  CALL timing_start('ahini_for_at') 
     474      ! 
     475      DO jk = 1, jpk 
     476        DO jj = 1, jpj 
     477          DO ji = 1, jpi 
     478            p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     479            p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     480            p_bortot = borat(ji,jj,jk) 
     481            IF (p_alkcb <= 0.) THEN 
     482                p_hini(ji,jj,jk) = 1.e-3 
     483            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     484                p_hini(ji,jj,jk) = 1.e-10_wp 
     485            ELSE 
     486                zca1 = p_dictot/( p_alkcb + rtrn ) 
     487                zba1 = p_bortot/ (p_alkcb + rtrn ) 
     488           ! Coefficients of the cubic polynomial 
     489                za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     490                za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     491                &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     492                za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     493                                        ! Taylor expansion around the minimum 
     494                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     495                                        ! for the minimum close to the root 
     496 
     497                IF(zd > 0.) THEN        ! If the discriminant is positive 
     498                  zsqrtd = SQRT(zd) 
     499                  IF(za2 < 0) THEN 
     500                    zhmin = (-za2 + zsqrtd)/3. 
     501                  ELSE 
     502                    zhmin = -za1/(za2 + zsqrtd) 
     503                  ENDIF 
     504                  p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     505                ELSE 
     506                  p_hini(ji,jj,jk) = 1.e-7 
     507                ENDIF 
     508             ! 
     509             ENDIF 
     510          END DO 
     511        END DO 
     512      END DO 
     513      ! 
     514      IF( nn_timing == 1 )  CALL timing_stop('ahini_for_at') 
     515      ! 
     516   END SUBROUTINE ahini_for_at 
     517 
     518   !=============================================================================== 
     519   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     520 
     521   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
     522   ! contributions to total alkalinity (the infimum and the supremum), i.e 
     523   ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 
     524 
     525   ! Argument variables 
     526   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
     527   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
     528 
     529   p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     530   &              - fluorid(:,:,:) 
     531   p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     532   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
     533 
     534   END SUBROUTINE anw_infsup 
     535 
     536 
     537   SUBROUTINE solve_at_general( p_hini, zhi ) 
     538 
     539   ! Universal pH solver that converges from any given initial value, 
     540   ! determines upper an lower bounds for the solution if required 
     541 
     542   ! Argument variables 
     543   !-------------------- 
     544   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
     545   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     546 
     547   ! Local variables 
     548   !----------------- 
     549   INTEGER   ::  ji, jj, jk, jn 
     550   REAL(wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor 
     551   REAL(wp)  ::  zdelta, zh_delta 
     552   REAL(wp)  ::  zeqn, zdeqndh, zalka 
     553   REAL(wp)  ::  aphscale 
     554   REAL(wp)  ::  znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 
     555   REAL(wp)  ::  znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 
     556   REAL(wp)  ::  znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 
     557   REAL(wp)  ::  znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 
     558   REAL(wp)  ::  znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 
     559   REAL(wp)  ::  znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 
     560   REAL(wp)  ::  zalk_wat, zdalk_wat 
     561   REAL(wp)  ::  zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 
     562   LOGICAL   ::  l_exitnow 
     563   REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 
     564   REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 
     565 
     566   IF( nn_timing == 1 )  CALL timing_start('solve_at_general') 
     567      !  Allocate temporary workspace 
     568   CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 
     569   CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 
     570 
     571   CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     572 
     573   rmask(:,:,:) = tmask(:,:,:) 
     574   zhi(:,:,:)   = 0. 
     575 
     576   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
     577   DO jk = 1, jpk 
     578      DO jj = 1, jpj 
     579         DO ji = 1, jpi 
     580            IF (rmask(ji,jj,jk) == 1.) THEN 
     581               p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     582               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     583               zh_ini = p_hini(ji,jj,jk) 
     584 
     585               zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     586 
     587               IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     588                 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     589               ELSE 
     590                 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     591               ENDIF 
     592 
     593               zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     594 
     595               IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     596                 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     597               ELSE 
     598                 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     599               ENDIF 
     600 
     601               zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     602            ENDIF 
     603         END DO 
     604      END DO 
     605   END DO 
     606 
     607   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     608 
     609   DO jn = 1, jp_maxniter_atgen  
     610   DO jk = 1, jpk 
     611      DO jj = 1, jpj 
     612         DO ji = 1, jpi 
     613            IF (rmask(ji,jj,jk) == 1.) THEN 
     614               zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     615               p_alktot = trb(ji,jj,jk,jptal) / zfact 
     616               zdic  = trb(ji,jj,jk,jpdic) / zfact 
     617               zbot  = borat(ji,jj,jk) 
     618               zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
     619               zsit = trb(ji,jj,jk,jpsil) / zfact 
     620               zst = sulfat (ji,jj,jk) 
     621               zft = fluorid(ji,jj,jk) 
     622               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     623               zh = zhi(ji,jj,jk) 
     624               zh_prev = zh 
     625 
     626               ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     627               znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     628               zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     629               zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     630               zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     631                             *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     632               zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     633 
     634 
     635               ! B(OH)3 - B(OH)4 : n=1, m=0 
     636               znumer_bor = akb3(ji,jj,jk) 
     637               zdenom_bor = akb3(ji,jj,jk) + zh 
     638               zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     639               zdnumer_bor = akb3(ji,jj,jk) 
     640               zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     641 
     642 
     643               ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     644               znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     645               &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     646               zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     647               &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     648               zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     649               zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     650               &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     651               &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     652               &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     653               &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     654               zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     655 
     656               ! H4SiO4 - H3SiO4 : n=1, m=0 
     657               znumer_sil = aksi3(ji,jj,jk) 
     658               zdenom_sil = aksi3(ji,jj,jk) + zh 
     659               zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     660               zdnumer_sil = aksi3(ji,jj,jk) 
     661               zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     662 
     663               ! HSO4 - SO4 : n=1, m=1 
     664               aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     665               znumer_so4 = aks3(ji,jj,jk) * aphscale 
     666               zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     667               zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     668               zdnumer_so4 = aks3(ji,jj,jk) 
     669               zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     670 
     671               ! HF - F : n=1, m=1 
     672               znumer_flu =  akf3(ji,jj,jk) 
     673               zdenom_flu =  akf3(ji,jj,jk) + zh 
     674               zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     675               zdnumer_flu = akf3(ji,jj,jk) 
     676               zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     677 
     678               ! H2O - OH 
     679               aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     680               zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     681               zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     682 
     683               ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     684               zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     685               &      + zalk_so4 + zalk_flu                       & 
     686               &      + zalk_wat - p_alktot 
     687 
     688               zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     689               &       + zalk_so4 + zalk_flu + zalk_wat) 
     690 
     691               zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     692               &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     693 
     694               ! Adapt bracketing interval 
     695               IF(zeqn > 0._wp) THEN 
     696                 zh_min(ji,jj,jk) = zh_prev 
     697               ELSEIF(zeqn < 0._wp) THEN 
     698                 zh_max(ji,jj,jk) = zh_prev 
     699               ENDIF 
     700 
     701               IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     702               ! if the function evaluation at the current point is 
     703               ! not decreasing faster than with a bisection step (at least linearly) 
     704               ! in absolute value take one bisection step on [ph_min, ph_max] 
     705               ! ph_new = (ph_min + ph_max)/2d0 
     706               ! 
     707               ! In terms of [H]_new: 
     708               ! [H]_new = 10**(-ph_new) 
     709               !         = 10**(-(ph_min + ph_max)/2d0) 
     710               !         = SQRT(10**(-(ph_min + phmax))) 
     711               !         = SQRT(zh_max * zh_min) 
     712                  zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     713                  zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     714               ELSE 
     715               ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     716               !           = -zdeqndh * LOG(10) * [H] 
     717               ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     718               ! 
     719               ! pH_new = pH_old + \deltapH 
     720               ! 
     721               ! [H]_new = 10**(-pH_new) 
     722               !         = 10**(-pH_old - \Delta pH) 
     723               !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     724               !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     725               !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     726 
     727                  zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     728 
     729                  IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     730                     zh          = zh_prev*EXP(zh_lnfactor) 
     731                  ELSE 
     732                     zh_delta    = zh_lnfactor*zh_prev 
     733                     zh          = zh_prev + zh_delta 
     734                  ENDIF 
     735 
     736                  IF( zh < zh_min(ji,jj,jk) ) THEN 
     737                     ! if [H]_new < [H]_min 
     738                     ! i.e., if ph_new > ph_max then 
     739                     ! take one bisection step on [ph_prev, ph_max] 
     740                     ! ph_new = (ph_prev + ph_max)/2d0 
     741                     ! In terms of [H]_new: 
     742                     ! [H]_new = 10**(-ph_new) 
     743                     !         = 10**(-(ph_prev + ph_max)/2d0) 
     744                     !         = SQRT(10**(-(ph_prev + phmax))) 
     745                     !         = SQRT([H]_old*10**(-ph_max)) 
     746                     !         = SQRT([H]_old * zh_min) 
     747                     zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     748                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     749                  ENDIF 
     750 
     751                  IF( zh > zh_max(ji,jj,jk) ) THEN 
     752                     ! if [H]_new > [H]_max 
     753                     ! i.e., if ph_new < ph_min, then 
     754                     ! take one bisection step on [ph_min, ph_prev] 
     755                     ! ph_new = (ph_prev + ph_min)/2d0 
     756                     ! In terms of [H]_new: 
     757                     ! [H]_new = 10**(-ph_new) 
     758                     !         = 10**(-(ph_prev + ph_min)/2d0) 
     759                     !         = SQRT(10**(-(ph_prev + ph_min))) 
     760                     !         = SQRT([H]_old*10**(-ph_min)) 
     761                     !         = SQRT([H]_old * zhmax) 
     762                     zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     763                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     764                  ENDIF 
     765               ENDIF 
     766 
     767               zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     768 
     769               ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     770               ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     771               ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     772 
     773               ! Alternatively: 
     774               ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     775               !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     776               !             < 1/LOG(10) * rdel 
     777 
     778               ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     779 
     780               ! rdel <-- pp_rdel_ah_target 
     781               l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     782 
     783               IF(l_exitnow) THEN  
     784                  rmask(ji,jj,jk) = 0. 
     785               ENDIF 
     786 
     787               zhi(ji,jj,jk) =  zh 
     788 
     789               IF(jn >= jp_maxniter_atgen) THEN 
     790                  zhi(ji,jj,jk) = -1._wp 
     791               ENDIF 
     792 
     793            ENDIF 
     794         END DO 
     795      END DO 
     796   END DO 
     797   END DO 
     798   ! 
     799   CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 
     800   CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 
     801 
     802 
     803   IF( nn_timing == 1 )  CALL timing_stop('solve_at_general') 
     804 
     805 
     806   END SUBROUTINE solve_at_general 
    323807 
    324808   INTEGER FUNCTION p4z_che_alloc() 
     
    326810      !!                     ***  ROUTINE p4z_che_alloc  *** 
    327811      !!---------------------------------------------------------------------- 
    328       ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk),   & 
    329       &         tempis(jpi,jpj,jpk), STAT=p4z_che_alloc ) 
     812      INTEGER ::   ierr(3)        ! Local variables 
     813      !!---------------------------------------------------------------------- 
     814 
     815      ierr(:) = 0 
     816 
     817      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) 
     818 
     819      ALLOCATE( akb3(jpi,jpj,jpk)     , tempis(jpi, jpj, jpk),       & 
     820         &      akw3(jpi,jpj,jpk)     , borat (jpi,jpj,jpk)  ,       & 
     821         &      aks3(jpi,jpj,jpk)     , akf3(jpi,jpj,jpk)    ,       & 
     822         &      ak1p3(jpi,jpj,jpk)    , ak2p3(jpi,jpj,jpk)   ,       & 
     823         &      ak3p3(jpi,jpj,jpk)    , aksi3(jpi,jpj,jpk)   ,       & 
     824         &      fluorid(jpi,jpj,jpk)  , sulfat(jpi,jpj,jpk)  ,       & 
     825         &      salinprac(jpi,jpj,jpk),                 STAT=ierr(2) ) 
     826 
     827      ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) ) 
     828 
     829      !* Variable for chemistry of the CO2 cycle 
     830      p4z_che_alloc = MAXVAL( ierr ) 
    330831      ! 
    331832      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
     
    333834   END FUNCTION p4z_che_alloc 
    334835 
    335 #else 
    336836   !!====================================================================== 
    337    !!  Dummy module :                                   No PISCES bio-model 
    338    !!====================================================================== 
    339 CONTAINS 
    340    SUBROUTINE p4z_che( kt )                   ! Empty routine 
    341       INTEGER, INTENT(in) ::   kt 
    342       WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 
    343    END SUBROUTINE p4z_che 
    344 #endif  
    345  
    346    !!====================================================================== 
    347 END MODULE p4zche 
     837END MODULE  p4zche 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r6140 r7646  
    55   !!====================================================================== 
    66   !! History :   3.5  !  2012-07 (O. Aumont, A. Tagliabue, C. Ethe) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_pisces 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_top'       and                                      TOP models 
    11    !!   'key_pisces'                                       PISCES bio-model 
     7   !!             3.6  !  2015-05  (O. Aumont) PISCES quota 
    128   !!---------------------------------------------------------------------- 
    139   !!   p4z_fechem       :  Compute remineralization/scavenging of iron 
     
    1814   USE trc             !  passive tracers common variables  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    20    USE p4zopt          !  optical model 
    2116   USE p4zche          !  chemical model 
    2217   USE p4zsbc          !  Boundary conditions from sediments 
     
    3025   PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90 
    3126 
    32    LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
    33    LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
    34    REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron  
    35    REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust  
    36    REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean  
    37  
    38 !!gm Not DOCTOR norm !!! 
     27   !! * Shared module variables 
     28   LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
     29   LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
     30   LOGICAL          ::  ln_fecolloid !: boolean for variable colloidal fraction 
     31   REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron  
     32   REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust  
     33   REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean  
     34   REAL(wp), PUBLIC ::  kfep         !: rate constant for nanoparticle formation 
     35 
    3936   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4037 
     
    5956      !!                    and one particulate form (ln_fechem) 
    6057      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    62       ! 
    63       INTEGER  ::   ji, jj, jk, jic 
    64       CHARACTER (len=25) :: charout 
     58      ! 
     59      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     60      ! 
     61      INTEGER  ::   ji, jj, jk, jic, jn 
    6562      REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac 
    66       REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll 
     63      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll, fe3sol 
    6764      REAL(wp) ::   zdenom1, zscave, zaggdfea, zaggdfeb, zcoag 
    6865      REAL(wp) ::   ztrc, zdust 
    69 #if ! defined key_kriest 
    70       REAL(wp) ::   zdenom, zdenom2 
    71 #endif 
    72       REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig 
    73       REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 
     66      REAL(wp) ::   zdenom2 
     67      REAL(wp) ::   zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2 
     68      REAL(wp) ::   zrum, zcodel, zargu, zlight 
    7469      REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 
    7570      REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 
    7671      REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 
    77       REAL(wp) :: ztfe, zoxy 
    78       REAL(wp) :: zstep 
     72      REAL(wp) :: ztfe, zoxy, zhplus 
     73      REAL(wp) :: zaggliga, zaggligb 
     74      REAL(wp) :: dissol, zligco 
     75      CHARACTER (len=25) :: charout 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 
     78      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zstrn2 
    7979      !!--------------------------------------------------------------------- 
    8080      ! 
    8181      IF( nn_timing == 1 )  CALL timing_start('p4z_fechem') 
    8282      ! 
    83       CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig ) 
     83      ! Allocate temporary workspace 
     84      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 
    8485      zFe3 (:,:,:) = 0. 
    8586      zFeL1(:,:,:) = 0. 
    8687      zTL1 (:,:,:) = 0. 
    8788      IF( ln_fechem ) THEN 
    88          CALL wrk_alloc( jpi,jpj,jpk,   zFe2, zFeL2, zTL2, zFeP ) 
     89         CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 ) 
     90         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
    8991         zFe2 (:,:,:) = 0. 
    9092         zFeL2(:,:,:) = 0. 
     
    100102         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    101103      ELSE 
    102          ztotlig(:,:,:) = ligand * 1E9 
     104        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
     105        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
     106        ENDIF 
    103107      ENDIF 
    104108 
    105109      IF( ln_fechem ) THEN 
     110         ! compute the day length depending on latitude and the day 
     111         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     112         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
     113 
     114         ! day length in hours 
     115         zstrn(:,:) = 0. 
     116         DO jj = 1, jpj 
     117            DO ji = 1, jpi 
     118               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     119               zargu = MAX( -1., MIN(  1., zargu ) ) 
     120               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     121            END DO 
     122         END DO 
     123 
     124         ! Maximum light intensity 
     125         zstrn2(:,:) = zstrn(:,:) / 24. 
     126         WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     127         zstrn(:,:) = 24. / zstrn(:,:) 
     128 
    106129         ! ------------------------------------------------------------ 
    107130         ! NEW FE CHEMISTRY ROUTINE from Tagliabue and Volker (2009) 
     
    109132         ! Chemistry is supposed to be fast enough to be at equilibrium 
    110133         ! ------------------------------------------------------------ 
    111          DO jk = 1, jpkm1 
     134         DO jn = 1, 2 
     135          DO jk = 1, jpkm1 
    112136            DO jj = 1, jpj 
    113137               DO ji = 1, jpi 
     138                  zlight = etot(ji,jj,jk) * zstrn(ji,jj) * REAL( 2-jn, wp ) 
     139                  zzstrn2 = zstrn2(ji,jj) * REAL( 2-jn, wp ) + (1. - zstrn2(ji,jj) ) * REAL( jn-1, wp ) 
    114140                  ! Calculate ligand concentrations : assume 2/3rd of excess goes to 
    115141                  ! strong ligands (L1) and 1/3rd to weak ligands (L2) 
     
    118144                  zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand 
    119145                  ! ionic strength from Millero et al. 1987 
    120                   zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn ) 
    121146                  zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 
    122                   zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 ) 
     147                  zoxy   = trb(ji,jj,jk,jpoxy) 
    123148                  ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 
    124                   zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  & 
    125                     &    - 0.04406 * SQRT( tsn(ji,jj,jk,jp_sal) ) - 0.002847 * tsn(ji,jj,jk,jp_sal) 
     149                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 )  & 
     150                    &    - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk) 
    126151                  zkox   = ( 10.** zkox ) * spd 
    127152                  zkox   = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn ) 
    128153                  ! PHOTOREDUCTION of complexed iron : Tagliabue and Arrigo (2006) 
    129                   zkph2 = MAX( 0., 15. * etot(ji,jj,jk) / ( etot(ji,jj,jk) + 2. ) ) 
     154                  zkph2 = MAX( 0., 15. * zlight / ( zlight + 2. ) ) * (1. - fr_i(ji,jj)) 
    130155                  zkph1 = zkph2 / 5. 
    131156                  ! pass the dfe concentration from PISCES 
     
    167192                        zphi = ACOS( zfff ) 
    168193                        DO jic = 1, 3 
    169                            zfunc = -2 * zr * COS( zphi / 3. + 2. * FLOAT( jic - 1 ) * rpi / 3. ) - za2 / 3. 
     194                           zfunc = -2 * zr * COS( zphi / 3. + 2. * REAL( jic - 1, wp ) * rpi / 3. ) - za2 / 3. 
    170195                           IF( zfunc > 0. .AND. zfunc <= ztfe)  zxs = zfunc 
    171196                        END DO 
     
    173198                  ENDIF 
    174199                  ! solve for the other Fe species 
    175                   zFe3(ji,jj,jk) = MAX( 0., zxs )  
    176                   zFep(ji,jj,jk) = MAX( 0., ( ks * zFe3(ji,jj,jk) / kpr ) ) 
     200                  zzFe3 = MAX( 0., zxs ) 
     201                  zzFep = MAX( 0., ( ks * zzFe3 / kpr ) ) 
    177202                  zkappa2 = ( kb2 + zkph2 ) / kl2 
    178                   zFeL2(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * zTL2(ji,jj,jk) ) / ( zkappa2 + zFe3(ji,jj,jk) ) ) 
    179                   zFeL1(ji,jj,jk) = MAX( 0., ( ztfe / zb - za / zb * zFe3(ji,jj,jk) - zc / zb * zFeL2(ji,jj,jk) ) ) 
    180                   zFe2 (ji,jj,jk) = MAX( 0., ( ( zkph1 * zFeL1(ji,jj,jk) + zkph2 * zFeL2(ji,jj,jk) ) / zkox ) ) 
     203                  zzFeL2 = MAX( 0., ( zzFe3 * zTL2(ji,jj,jk) ) / ( zkappa2 + zzFe3 ) ) 
     204                  zzFeL1 = MAX( 0., ( ztfe / zb - za / zb * zzFe3 - zc / zb * zzFeL2 ) ) 
     205                  zzFe2  = MAX( 0., ( ( zkph1 * zzFeL1 + zkph2 * zzFeL2 ) / zkox ) ) 
     206                  zFe3(ji,jj,jk)  = zFe3(ji,jj,jk)  + zzFe3 * zzstrn2 
     207                  zFe2(ji,jj,jk)  = zFe2(ji,jj,jk)  + zzFe2 * zzstrn2 
     208                  zFeL2(ji,jj,jk) = zFeL2(ji,jj,jk) + zzFeL2 * zzstrn2 
     209                  zFeL1(ji,jj,jk) = zFeL1(ji,jj,jk) + zzFeL1 * zzstrn2 
     210                  zFeP(ji,jj,jk)  = zFeP(ji,jj,jk)  + zzFeP * zzstrn2 
    181211               END DO 
    182212            END DO 
     213         END DO 
    183214         END DO 
    184215      ELSE 
     
    206237         ! 
    207238      ENDIF 
    208       ! 
     239 
    209240      zdust = 0.         ! if no dust available 
    210       ! 
    211241      DO jk = 1, jpkm1 
    212242         DO jj = 1, jpj 
    213243            DO ji = 1, jpi 
    214                zstep = xstep 
    215 # if defined key_degrad 
    216                zstep = zstep * facvol(ji,jj,jk) 
    217 # endif 
    218244               ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    219245               ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
     
    224250                  zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9 
    225251               ELSE 
    226                   zfeequi = zFe3(ji,jj,jk) * 1E-9  
    227                   zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     252                  zfeequi = zFe3(ji,jj,jk) * 1E-9 
     253                  IF (ln_fecolloid) THEN 
     254                     zhplus   = max( rtrn, hi(ji,jj,jk) ) 
     255                     fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     256                     &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     257                     &         + fesol(ji,jj,jk,5) / zhplus ) 
     258                     zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) ) 
     259                  ELSE 
     260                     zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     261                     fe3sol  = 0. 
     262                  ENDIF 
    228263               ENDIF 
    229 #if defined key_kriest 
    230                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    231 #else 
     264               ! 
    232265               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    233 #endif 
    234266               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 
    235267               zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc 
    236                zscave = zfeequi * zlam1b * zstep 
     268               zscave = zfeequi * zlam1b * xstep 
    237269 
    238270               ! Compute the different ratios for scavenging of iron 
     
    240272               ! --------------------------------------------------------- 
    241273               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b 
    242 #if ! defined key_kriest 
    243274               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b 
    244 #endif 
    245275 
    246276               !  Increased scavenging for very high iron concentrations found near the coasts  
     
    249279               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    250280               zlamfac = MIN( 1.  , zlamfac ) 
    251 !!gm very small BUG :  it is unlikely but possible that gdept_n = 0  ..... 
    252281               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    253282               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
    254                zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 
     283               zcoag   = zfeequi * zlam1b * xstep + 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
    255284 
    256285               !  Compute the coagulation of colloidal iron. This parameterization  
     
    259288               !  ---------------------------------------------------------------- 
    260289               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    261                    &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) ) 
    262                zaggdfea = zlam1a * zstep * zfecoll 
    263 #if defined key_kriest 
    264                zaggdfeb = 0. 
     290                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     291               zaggdfea = zlam1a * xstep * zfecoll 
    265292               ! 
    266                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 
    267                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb 
    268 #else 
    269293               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    270                zaggdfeb = zlam1b * zstep * zfecoll 
     294               zaggdfeb = zlam1b * xstep * zfecoll 
    271295               ! 
    272                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 
     296               ! precipitation of Fe3+, creation of nanoparticles 
     297               precip(ji,jj,jk) = MAX( 0., ( zfeequi - fe3sol ) ) * kfep * xstep 
     298               ! 
     299               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
     300               &                     - zcoag - precip(ji,jj,jk) 
    273301               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    274302               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
    275 #endif 
     303               ! 
    276304            END DO 
    277305         END DO 
     
    280308      !  Define the bioavailable fraction of iron 
    281309      !  ---------------------------------------- 
    282       IF( ln_fechem ) THEN 
    283           biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
    284       ELSE 
    285           biron(:,:,:) = trb(:,:,:,jpfer)  
    286       ENDIF 
    287  
     310      IF( ln_fechem ) THEN  ;  biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
     311      ELSE                  ;  biron(:,:,:) = trb(:,:,:,jpfer)  
     312      ENDIF 
     313      ! 
     314      IF( ln_ligand ) THEN 
     315         ! 
     316         DO jk = 1, jpkm1 
     317            DO jj = 1, jpj 
     318               DO ji = 1, jpi 
     319                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
     320                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     321                  ! 
     322                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     323                  zligco   = MAX( ( 0.1 * trb(ji,jj,jk,jplgw) ), ( trb(ji,jj,jk,jplgw) - fe3sol ) ) 
     324                  zaggliga = zlam1a * xstep * zligco 
     325                  zaggligb = zlam1b * xstep * zligco 
     326                  tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk) 
     327                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
     328               END DO 
     329            END DO 
     330         END DO 
     331         ! 
     332         IF( .NOT.ln_fechem) THEN 
     333            plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
     334            plig(:,:,:) =  MAX( 0. , plig(:,:,:) ) 
     335         ENDIF 
     336         ! 
     337      ENDIF 
    288338      !  Output of some diagnostics variables 
    289339      !     --------------------------------- 
    290       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     340      IF( lk_iomput ) THEN 
     341         IF( knt == nrdttrc ) THEN 
    291342         IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+ 
    292343         IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1 
     
    300351            IF( iom_use("TL2")  ) CALL iom_put("TL2"    , zTL2   (:,:,:)       * tmask(:,:,:) )   ! TL2 
    301352         ENDIF 
     353         ENDIF 
    302354      ENDIF 
    303355 
     
    308360      ENDIF 
    309361      ! 
    310                        CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 
    311       IF( ln_fechem )  CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     362      CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 
     363      IF( ln_fechem )  THEN 
     364         CALL wrk_dealloc( jpi, jpj,      zstrn, zstrn2 ) 
     365         CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     366      ENDIF 
    312367      ! 
    313368      IF( nn_timing == 1 )  CALL timing_stop('p4z_fechem') 
     
    328383      !! 
    329384      !!---------------------------------------------------------------------- 
    330       NAMELIST/nampisfer/ ln_fechem, ln_ligvar, xlam1, xlamdust, ligand  
     385      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep  
    331386      INTEGER :: ios                 ! Local integer output status for namelist read 
    332387 
     
    344399         WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer' 
    345400         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    346          WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem =', ln_fechem 
    347          WRITE(numout,*) '    variable concentration of ligand          ln_ligvar =', ln_ligvar 
    348          WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
    349          WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust  =', xlamdust 
    350          WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand 
     401         WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem    =', ln_fechem 
     402         WRITE(numout,*) '    variable concentration of ligand          ln_ligvar    =', ln_ligvar 
     403         WRITE(numout,*) '    Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid 
     404         WRITE(numout,*) '    scavenging rate of Iron                   xlam1        =', xlam1 
     405         WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust     =', xlamdust 
     406         WRITE(numout,*) '    ligand concentration in the ocean         ligand       =', ligand 
     407         WRITE(numout,*) '    rate constant for nanoparticle formation  kfep         =', kfep 
    351408      ENDIF 
    352409      ! 
     
    377434      ! 
    378435   END SUBROUTINE p4z_fechem_init 
    379  
    380 #else 
    381    !!====================================================================== 
    382    !!  Dummy module :                                   No PISCES bio-model 
    383    !!====================================================================== 
    384 CONTAINS 
    385    SUBROUTINE p4z_fechem                    ! Empty routine 
    386    END SUBROUTINE p4z_fechem 
    387 #endif  
    388  
    389436   !!====================================================================== 
    390437END MODULE p4zfechem 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r6962 r7646  
    1111   !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_pisces 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_pisces'                                       PISCES bio-model 
    16    !!---------------------------------------------------------------------- 
    1713   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    1814   !!   p4z_flx_init  :   Read the namelist 
     
    2622   USE iom                          !  I/O manager 
    2723   USE fldread                      !  read input fields 
    28 #if defined key_cpl_carbon_cycle 
    29    USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2                
    30 #endif 
    3124 
    3225   IMPLICIT NONE 
     
    4841 
    4942   !                               !!* nampisatm namelist (Atmospheric PRessure) * 
    50    LOGICAL, PUBLIC ::   ln_presatm  !: ref. pressure: global mean Patm (F) or a constant (F) 
    51  
    52    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  patm      ! atmospheric pressure at kt                 [N/m2] 
    53    TYPE(FLD), ALLOCATABLE,       DIMENSION(:)    ::  sf_patm   ! structure of input fields (file informations, fields read) 
    54  
    55  
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
     43   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F) 
     44   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 
     45 
     46   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2] 
     47   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read) 
     48   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read) 
     49 
    5750   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    5851 
     
    7467      !! ** Method  :  
    7568      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
    76       !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
    7769      !!              - Remove Wanninkhof chemical enhancement; 
    7870      !!              - Add option for time-interpolation of atcco2.txt   
     
    8577      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    8678      REAL(wp) ::   zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 
    87       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     79      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2 
    8880      REAL(wp) ::   zyr_dec, zdco2dt 
    8981      CHARACTER (len=25) :: charout 
     
    10092      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    10193 
    102       IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
    103  
    104       IF( ln_co2int ) THEN  
     94      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 
     95 
     96      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN  
    10597         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
    10698         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
     
    116108      ENDIF 
    117109 
    118 #if defined key_cpl_carbon_cycle 
    119       satmco2(:,:) = atm_co2(:,:) 
    120 #endif 
    121  
    122       DO jm = 1, 10 
    123          DO jj = 1, jpj 
    124             DO ji = 1, jpi 
    125  
    126                ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    127                zbot  = borat(ji,jj,1) 
    128                zfact = rhop(ji,jj,1) / 1000. + rtrn 
    129                zdic  = trb(ji,jj,1,jpdic) / zfact 
    130                zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    131                zalka = trb(ji,jj,1,jptal) / zfact 
    132  
    133                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    134                zalk  = zalka - (  akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1)    & 
    135                &       + zbot / ( 1.+ zph / akb3(ji,jj,1) )  ) 
    136  
    137                ! CALCULATE [H+] AND [H2CO3] 
    138                zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   & 
    139                   &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  ) 
    140                zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 ) 
    141                zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact 
    142                hi(ji,jj,1)   = zah2 * zfact 
    143             END DO 
     110      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
     111 
     112      DO jj = 1, jpj 
     113         DO ji = 1, jpi 
     114            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     115            zfact = rhop(ji,jj,1) / 1000. + rtrn 
     116            zdic  = trb(ji,jj,1,jpdic) 
     117            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     118            ! CALCULATE [H2CO3] 
     119            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
    144120         END DO 
    145121      END DO 
    146  
    147122 
    148123      ! -------------- 
     
    167142            zkgwan = 0.251 * zws 
    168143            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    169 # if defined key_degrad 
    170             zkgwan = zkgwan * facvol(ji,jj,1) 
    171 #endif  
    172144            ! compute gas exchange for CO2 and O2 
    173145            zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
     
    176148      END DO 
    177149 
     150 
    178151      DO jj = 1, jpj 
    179152         DO ji = 1, jpi 
    180             ztkel     = tsn(ji,jj,1,jp_tem) + 273.15 
    181             zsal      = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     153            ztkel = tempis(ji,jj,1) + 273.15 
     154            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    182155            zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
    183156            zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
     
    232205         ENDIF 
    233206         IF( iom_use( "Dpo2" ) )  THEN 
    234            zw2d(:,:) = ( atcox * patm(:,:) - atcox * trn(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
     207           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    235208           CALL iom_put( "Dpo2"  , zw2d ) 
    236209         ENDIF 
     
    239212         ! 
    240213         CALL wrk_dealloc( jpi, jpj, zw2d ) 
    241       ELSE 
    242          IF( ln_diatrc ) THEN 
    243             trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r  
    244             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
    245             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
    246             trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)  
    247          ENDIF 
    248214      ENDIF 
    249215      ! 
     
    287253         WRITE(numout,*) ' ' 
    288254      ENDIF 
    289       IF( .NOT.ln_co2int ) THEN 
     255     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    290256         IF(lwp) THEN                         ! control print 
    291257            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
     
    293259         ENDIF 
    294260         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    295       ELSE 
     261      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    296262         IF(lwp)  THEN 
    297263            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
     
    315281         END DO 
    316282         CLOSE(numco2) 
    317       ENDIF 
     283      ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN 
     284         IF(lwp)  THEN 
     285            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     286            WRITE(numout,*) ' ' 
     287         ENDIF 
     288      ELSE 
     289         IF(lwp)  THEN 
     290            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     291            WRITE(numout,*) ' ' 
     292         ENDIF 
     293      ENDIF 
     294 
    318295      ! 
    319296      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
     
    341318      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    342319      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
    343       !! 
    344       NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 
     320      TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read 
     321      !! 
     322      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 
    345323 
    346324      !                                         ! ----------------------- ! 
     
    361339            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
    362340            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
     341            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2 
    363342            WRITE(numout,*) 
    364343         ENDIF 
     
    373352         ENDIF 
    374353         !                                          
     354         IF( ln_presatmco2 ) THEN 
     355            ALLOCATE( sf_atmco2(1), STAT=ierr )           !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2 
     356            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' ) 
     357            ! 
     358            CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' ) 
     359                                   ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1)   ) 
     360            IF( sn_atmco2%ln_tint )  ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) ) 
     361         ENDIF 
     362         ! 
    375363         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
    376364         ! 
     
    382370      ENDIF 
    383371      ! 
     372      IF( ln_presatmco2 ) THEN 
     373         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2 
     374         satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure 
     375      ELSE 
     376         satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file 
     377      ENDIF 
     378      ! 
    384379   END SUBROUTINE p4z_patm 
    385380 
     381 
    386382   INTEGER FUNCTION p4z_flx_alloc() 
    387383      !!---------------------------------------------------------------------- 
    388384      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    389385      !!---------------------------------------------------------------------- 
    390       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
     386      ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    391387      ! 
    392388      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
    393389      ! 
    394390   END FUNCTION p4z_flx_alloc 
    395  
    396 #else 
    397    !!====================================================================== 
    398    !!  Dummy module :                                   No PISCES bio-model 
    399    !!====================================================================== 
    400 CONTAINS 
    401    SUBROUTINE p4z_flx( kt )                   ! Empty routine 
    402       INTEGER, INTENT( in ) ::   kt 
    403       WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt 
    404    END SUBROUTINE p4z_flx 
    405 #endif  
    406391 
    407392   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    r5656 r7646  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    12    !!---------------------------------------------------------------------- 
    139   !!   p4z_int        :  interpolation and computation of various accessory fields 
    1410   !!---------------------------------------------------------------------- 
     
    1612   USE trc             !  passive tracers common variables  
    1713   USE sms_pisces      !  PISCES Source Minus Sink variables 
    18    USE iom 
    1914 
    2015   IMPLICIT NONE 
     
    7065   END SUBROUTINE p4z_int 
    7166 
    72 #else 
    73    !!====================================================================== 
    74    !!  Dummy module :                                   No PISCES bio-model 
    75    !!====================================================================== 
    76 CONTAINS 
    77    SUBROUTINE p4z_int                   ! Empty routine 
    78       WRITE(*,*) 'p4z_int: You should not have seen this print! error?' 
    79    END SUBROUTINE p4z_int 
    80 #endif  
    81  
    8267   !!====================================================================== 
    8368END MODULE p4zint 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r6945 r7646  
    88   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota  
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_lim        :   Compute the nutrients limitation terms  
    1511   !!   p4z_lim_init   :   Read the namelist  
     
    1814   USE trc             ! Tracers defined 
    1915   USE sms_pisces      ! PISCES variables 
    20    USE p4zopt          ! Optical 
    2116   USE iom             !  I/O manager 
    2217 
     
    2621   PUBLIC p4z_lim     
    2722   PUBLIC p4z_lim_init     
     23   PUBLIC p4z_lim_alloc 
    2824 
    2925   !! * Shared module variables 
     
    4844   REAL(wp), PUBLIC ::  qdfelim     !:  optimal Fe quota for diatoms 
    4945   REAL(wp), PUBLIC ::  caco3r      !:  mean rainratio  
     46 
     47   !!* Phytoplankton limitation terms 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ??? 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ??? 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ??? 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ??? 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ??? 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ??? 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ??? 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ??? 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ??? 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbac    !: ?? 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbacl   !: ?? 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ??? 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ??? 
    5063 
    5164   ! Coefficient for iron limitation 
     
    224237      !!---------------------------------------------------------------------- 
    225238 
    226       NAMELIST/nampislim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   & 
     239      NAMELIST/namp4zlim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   & 
    227240         &                concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd,          &  
    228241         &                xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 
     
    230243 
    231244      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    232       READ  ( numnatp_ref, nampislim, IOSTAT = ios, ERR = 901) 
    233 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist', lwp ) 
     245      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 
     246901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 
    234247 
    235248      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
    236       READ  ( numnatp_cfg, nampislim, IOSTAT = ios, ERR = 902 ) 
    237 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist', lwp ) 
    238       IF(lwm) WRITE ( numonp, nampislim ) 
     249      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 
     250902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 
     251      IF(lwm) WRITE ( numonp, namp4zlim ) 
    239252 
    240253      IF(lwp) THEN                         ! control print 
    241254         WRITE(numout,*) ' ' 
    242          WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 
     255         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim' 
    243256         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    244257         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
     
    268281   END SUBROUTINE p4z_lim_init 
    269282 
    270 #else 
    271    !!====================================================================== 
    272    !!  Dummy module :                                   No PISCES bio-model 
    273    !!====================================================================== 
    274 CONTAINS 
    275    SUBROUTINE p4z_lim                   ! Empty routine 
    276    END SUBROUTINE p4z_lim 
    277 #endif  
     283   INTEGER FUNCTION p4z_lim_alloc() 
     284      !!---------------------------------------------------------------------- 
     285      !!                     ***  ROUTINE p5z_lim_alloc  *** 
     286      !!---------------------------------------------------------------------- 
     287      USE lib_mpp , ONLY: ctl_warn 
     288      !!---------------------------------------------------------------------- 
     289 
     290      !*  Biological arrays for phytoplankton growth 
     291      ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
     292         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
     293         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       & 
     294         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       & 
     295         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
     296         &      xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk),       & 
     297         &      concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
     298         &      xlimsi  (jpi,jpj,jpk), STAT=p4z_lim_alloc ) 
     299      ! 
     300      IF( p4z_lim_alloc /= 0 ) CALL ctl_warn('p4z_lim_alloc : failed to allocate arrays.') 
     301      ! 
     302   END FUNCTION p4z_lim_alloc 
    278303 
    279304   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r6945 r7646  
    1111   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence 
    1212   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution 
    13    !!---------------------------------------------------------------------- 
    14 #if defined key_pisces 
    15    !!---------------------------------------------------------------------- 
    16    !!   'key_pisces'                                       PISCES bio-model 
     13   !!             3.6  !  2015-05  (O. Aumont) PISCES quota 
    1714   !!---------------------------------------------------------------------- 
    1815   !!   p4z_lys        :   Compute the CaCO3 dissolution  
     
    2219   USE trc             !  passive tracers common variables  
    2320   USE sms_pisces      !  PISCES Source Minus Sink variables 
     21   USE p4zche          !  Chemical model 
    2422   USE prtctl_trc      !  print control for debugging 
    2523   USE iom             !  I/O manager 
     
    6159      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6260      INTEGER  ::   ji, jj, jk, jn 
    63       REAL(wp) ::   zalk, zdic, zph, zah2 
    64       REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
     61      REAL(wp) ::   zdispot, zfact, zcalcon 
    6562      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    6663      CHARACTER (len=25) :: charout 
    67       REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss    
     64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat 
    6865      !!--------------------------------------------------------------------- 
    6966      ! 
    7067      IF( nn_timing == 1 )  CALL timing_start('p4z_lys') 
    7168      ! 
    72       CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 
     69      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 
    7370      ! 
    7471      zco3    (:,:,:) = 0. 
    7572      zcaldiss(:,:,:) = 0. 
     73      zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
    7674      !     ------------------------------------------- 
    7775      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    7876      !     ------------------------------------------- 
    79        
    80       DO jn = 1, 5                               !  BEGIN OF ITERATION 
    81          ! 
    82          DO jk = 1, jpkm1 
    83             DO jj = 1, jpj 
    84                DO ji = 1, jpi 
    85                   zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    86                   zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    87                   zdic  = trb(ji,jj,jk,jpdic) / zfact 
    88                   zalka = trb(ji,jj,jk,jptal) / zfact 
    89                   ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    90                   zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn )  & 
    91                   &       + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    92                   ! CALCULATE [H+] and [CO3--] 
    93                   zaldi = zdic - zalk 
    94                   zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
    95                   zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
    96                   ! 
    97                   zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
    98                   hi(ji,jj,jk)   = zah2 * zfact 
    99                END DO 
     77 
     78      CALL solve_at_general(zhinit, zhi) 
     79 
     80      DO jk = 1, jpkm1 
     81         DO jj = 1, jpj 
     82            DO ji = 1, jpi 
     83               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
     84               &                + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
     85               hi(ji,jj,jk)   = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    10086            END DO 
    10187         END DO 
    102          ! 
    103       END DO  
     88      END DO 
    10489 
    10590      !     --------------------------------------------------------- 
     
    115100               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    116101               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
    117                zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     102               zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
    118103               zfact    = rhop(ji,jj,jk) / 1000._wp 
    119104               zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
     
    129114               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    130115               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
    131 # if defined key_degrad 
    132                zdispot = zdispot * facvol(ji,jj,jk) 
    133 # endif 
    134116              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    135117              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    136118              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    137               zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) 
    138119              ! 
    139120              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
     
    150131         IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3            * tmask(:,:,:) ) 
    151132         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    152       ELSE 
    153          IF( ln_diatrc ) THEN 
    154             trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 
    155             trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:) 
    156             trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:)           * tmask(:,:,:) 
    157          ENDIF 
    158133      ENDIF 
    159134      ! 
     
    164139      ENDIF 
    165140      ! 
    166       CALL wrk_dealloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 
     141      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 
    167142      ! 
    168143      IF( nn_timing == 1 )  CALL timing_stop('p4z_lys') 
     
    183158      !! 
    184159      !!---------------------------------------------------------------------- 
    185       INTEGER  ::  ji, jj, jk 
    186160      INTEGER  ::  ios                 ! Local integer output status for namelist read 
    187       REAL(wp) ::  zcaralk, zbicarb, zco3 
    188       REAL(wp) ::  ztmas, ztmas1 
    189161 
    190162      NAMELIST/nampiscal/ kdca, nca 
     
    212184      ! 
    213185   END SUBROUTINE p4z_lys_init 
    214  
    215 #else 
    216    !!====================================================================== 
    217    !!  Dummy module :                                   No PISCES bio-model 
    218    !!====================================================================== 
    219 CONTAINS 
    220    SUBROUTINE p4z_lys( kt )                   ! Empty routine 
    221       INTEGER, INTENT( in ) ::   kt 
    222       WRITE(*,*) 'p4z_lys: You should not have seen this print! error?', kt 
    223    END SUBROUTINE p4z_lys 
    224 #endif  
    225186   !!====================================================================== 
    226187END MODULE p4zlys 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5836 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_meso       :   Compute the sources/sinks for mesozooplankton 
    1511   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
     
    1814   USE trc             !  passive tracers common variables  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    20    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    21    USE p4zint          !  interpolation and computation of various fields 
    2216   USE p4zprod         !  production 
    2317   USE prtctl_trc      !  print control for debugging 
     
    7064      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    7165      REAL(wp) :: zgraze2 , zdenom, zdenom2 
    72       REAL(wp) :: zfact   , zstep, zfood, zfoodlim, zproport 
    73       REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2 
     66      REAL(wp) :: zfact   , zfood, zfoodlim, zproport 
     67      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    7468      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 
    7569      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat, zgrasratn 
    76 #if defined key_kriest 
    77       REAL znumpoc 
    78 #endif 
    7970      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 
    8071      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
     
    8778      IF( nn_timing == 1 )  CALL timing_start('p4z_meso') 
    8879      ! 
    89       IF( lk_iomput ) THEN 
    90          CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    91          zgrazing(:,:,:) = 0._wp 
    92       ENDIF 
     80      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
     81      zgrazing(:,:,:) = 0._wp 
    9382 
    9483      DO jk = 1, jpkm1 
     
    9685            DO ji = 1, jpi 
    9786               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    98 # if defined key_degrad 
    99                zstep     = xstep * facvol(ji,jj,jk) 
    100 # else 
    101                zstep     = xstep 
    102 # endif 
    103                zfact     = zstep * tgfunc2(ji,jj,jk) * zcompam 
     87               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    10488 
    10589               !  Respiration rates of both zooplankton 
     
    126110               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    127111               zdenom2   = zdenom / ( zfood + rtrn ) 
    128                zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
     112               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
    129113 
    130114               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
     
    140124               !  ---------------------------------- 
    141125               !  ---------------------------------- 
    142 # if ! defined key_kriest 
    143                zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      & 
     126               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    144127               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) 
    145128               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    146 # endif 
    147                zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     & 
     129               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    148130               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) 
    149131               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    150132              ! 
    151 # if ! defined key_kriest 
    152133              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    153134              ! Compute the proportion of filter feeders 
     
    158139              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    159140              zratio2   = zratio * zratio 
    160               zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      & 
     141              zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    161142               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    162143               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
     
    171152              &   + zgrazpoc + zgrazffep + zgrazffeg 
    172153              zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
    173 # else 
    174               zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep 
    175               ! Compute the proportion of filter feeders 
    176               zproport  = zgrazffep / ( zgraztot + rtrn ) 
    177               zgrazffep = zproport * zgrazffep 
    178               zgrazfffp = zproport * zgrazfffp 
    179               zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep 
    180               zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) + zgrazpoc + zgrazffep 
    181               zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp 
    182 # endif 
    183154 
    184155              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
    185               IF( lk_iomput )  zgrazing(ji,jj,jk) = zgraztot 
     156              zgrazing(ji,jj,jk) = zgraztot 
    186157 
    187158              !    Mesozooplankton efficiency 
     
    202173               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    203174               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     175               ! 
     176               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
     177               ! 
    204178               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    205179               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     
    220194               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    221195 
    222                ! calcite production 
    223                zprcaca = xfracal(ji,jj,jk) * zgrazn 
    224                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    225                ! 
    226                zprcaca = part2 * zprcaca 
    227                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    228                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    229                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    230 #if defined key_kriest 
    231               znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    232               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2 
    233               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      & 
    234                  &   + zmortzgoc * xkr_dmeso - zgrazffep * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    235               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortzgoc - zgrazfffp - zgrazpof    & 
    236                  &                 + zgraztotf * unass2 
    237 #else 
    238196              tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
     197              prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
     198              conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    239199              tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     200              prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     201              consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    240202              tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    241203              tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
    242204                 &                + zgraztotf * unass2 - zfracfe 
    243 #endif 
     205              zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
     206              zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     207              ! calcite production 
     208              zprcaca = xfracal(ji,jj,jk) * zgrazn 
     209              prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     210              ! 
     211              zprcaca = part2 * zprcaca 
     212              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
     213              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
     214              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    244215            END DO 
    245216         END DO 
     
    265236      ENDIF 
    266237      ! 
    267       IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
     238      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
    268239      ! 
    269240      IF( nn_timing == 1 )  CALL timing_stop('p4z_meso') 
     
    285256      !!---------------------------------------------------------------------- 
    286257 
    287       NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     258      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
    288259         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
    289260         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
     
    291262 
    292263      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
    293       READ  ( numnatp_ref, nampismes, IOSTAT = ios, ERR = 901) 
    294 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist', lwp ) 
     264      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
     265901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 
    295266 
    296267      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
    297       READ  ( numnatp_cfg, nampismes, IOSTAT = ios, ERR = 902 ) 
    298 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist', lwp ) 
    299       IF(lwm) WRITE ( numonp, nampismes ) 
     268      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
     269902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 
     270      IF(lwm) WRITE ( numonp, namp4zmes ) 
    300271 
    301272 
    302273      IF(lwp) THEN                         ! control print 
    303274         WRITE(numout,*) ' '  
    304          WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
     275         WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes' 
    305276         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    306277         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
     
    327298   END SUBROUTINE p4z_meso_init 
    328299 
    329  
    330 #else 
    331    !!====================================================================== 
    332    !!  Dummy module :                                   No PISCES bio-model 
    333    !!====================================================================== 
    334 CONTAINS 
    335    SUBROUTINE p4z_meso                    ! Empty routine 
    336    END SUBROUTINE p4z_meso 
    337 #endif  
    338  
    339300   !!====================================================================== 
    340301END MODULE p4zmeso 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5836 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_micro       :   Compute the sources/sinks for microzooplankton 
    1511   !!   p4z_micro_init  :   Initialize and read the appropriate namelist 
     
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2016   USE p4zlim          !  Co-limitations 
    21    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    22    USE p4zint          !  interpolation and computation of various fields 
    2317   USE p4zprod         !  production 
    2418   USE iom             !  I/O manager 
     
    7165      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 
    7266      REAL(wp) :: zgraze  , zdenom, zdenom2 
    73       REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     67      REAL(wp) :: zfact   , zfood, zfoodlim 
    7468      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 
    7569      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
     
    8377      IF( nn_timing == 1 )  CALL timing_start('p4z_micro') 
    8478      ! 
    85       IF( lk_iomput )  CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
     79      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    8680      ! 
    8781      DO jk = 1, jpkm1 
     
    8983            DO ji = 1, jpi 
    9084               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    91                zstep   = xstep 
    92 # if defined key_degrad 
    93                zstep = zstep * facvol(ji,jj,jk) 
    94 # endif 
    95                zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
     85               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    9686 
    9787               !  Respiration rates of both zooplankton 
     
    115105               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    116106               zdenom2   = zdenom / ( zfood + rtrn ) 
    117                zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)  
     107               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)  
    118108 
    119109               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
     
    130120 
    131121               ! Grazing by microzooplankton 
    132                IF( ln_diatrc .AND. lk_iomput )  zgrazing(ji,jj,jk) = zgraztot 
     122               zgrazing(ji,jj,jk) = zgraztot 
    133123 
    134124               !    Various remineralization and excretion terms 
     
    148138               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    149139               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     140               ! 
     141               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 
     142               ! 
    150143               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    151144               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    152145               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     146               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 
    153147               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
    154148               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    155149               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    156 #if defined key_kriest 
    157                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_dmicro 
    158 #endif 
    159150               !   Update the arrays TRA which contain the biological sources and sinks 
    160151               !   -------------------------------------------------------------------- 
     
    170161               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171162               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
     163               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
     164               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    172165               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
    173166               ! 
     
    180173               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    181174               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    182 #if defined key_kriest 
    183                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro & 
    184                                                          - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    185 #endif 
    186175            END DO 
    187176         END DO 
    188177      END DO 
    189178      ! 
    190       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    191          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    192          IF( iom_use( "GRAZ1" ) ) THEN 
    193             zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
    194             CALL iom_put( "GRAZ1", zw3d ) 
     179      IF( lk_iomput ) THEN 
     180         IF( knt == nrdttrc ) THEN 
     181           CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
     182           IF( iom_use( "GRAZ1" ) ) THEN 
     183              zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
     184              CALL iom_put( "GRAZ1", zw3d ) 
     185           ENDIF 
     186           CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    195187         ENDIF 
    196          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    197188      ENDIF 
    198189      ! 
     
    203194      ENDIF 
    204195      ! 
    205       IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
     196      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
    206197      ! 
    207198      IF( nn_timing == 1 )  CALL timing_stop('p4z_micro') 
     
    224215      !!---------------------------------------------------------------------- 
    225216 
    226       NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     217      NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
    227218         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
    228219         &                xthresh, xkgraz, epsher, sigma1, unass 
     
    230221 
    231222      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 
    232       READ  ( numnatp_ref, nampiszoo, IOSTAT = ios, ERR = 901) 
    233 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in reference namelist', lwp ) 
     223      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 
     224901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 
    234225 
    235226      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 
    236       READ  ( numnatp_cfg, nampiszoo, IOSTAT = ios, ERR = 902 ) 
    237 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in configuration namelist', lwp ) 
    238       IF(lwm) WRITE ( numonp, nampiszoo ) 
     227      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 
     228902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 
     229      IF(lwm) WRITE ( numonp, namp4zzoo ) 
    239230 
    240231      IF(lwp) THEN                         ! control print 
    241232         WRITE(numout,*) ' ' 
    242          WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
     233         WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo' 
    243234         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    244235         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
     
    261252   END SUBROUTINE p4z_micro_init 
    262253 
    263 #else 
    264    !!====================================================================== 
    265    !!  Dummy module :                                   No PISCES bio-model 
    266    !!====================================================================== 
    267 CONTAINS 
    268    SUBROUTINE p4z_micro                    ! Empty routine 
    269    END SUBROUTINE p4z_micro 
    270 #endif  
    271  
    272254   !!====================================================================== 
    273255END MODULE p4zmicro 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r5836 r7646  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    12    !!---------------------------------------------------------------------- 
    139   !!   p4z_mort       :   Compute the mortality terms for phytoplankton 
    1410   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
     
    1713   USE trc             !  passive tracers common variables  
    1814   USE sms_pisces      !  PISCES Source Minus Sink variables 
    19    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    2015   USE p4zprod         !  Primary productivity  
     16   USE p4zlim          !  Phytoplankton limitation terms 
    2117   USE prtctl_trc      !  print control for debugging 
    2218 
     
    3430   REAL(wp), PUBLIC :: mprat2  !: 
    3531 
    36  
    3732   !!---------------------------------------------------------------------- 
    3833   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    7368      REAL(wp) :: zsizerat, zcompaph 
    7469      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
    75       REAL(wp) :: ztortp , zrespp , zmortp , zstep 
     70      REAL(wp) :: ztortp , zrespp , zmortp  
    7671      CHARACTER (len=25) :: charout 
    7772      !!--------------------------------------------------------------------- 
     
    8479            DO ji = 1, jpi 
    8580               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    86                zstep    = xstep 
    87 # if defined key_degrad 
    88                zstep    = zstep * facvol(ji,jj,jk) 
    89 # endif 
    9081               !     When highly limited by macronutrients, very small cells  
    9182               !     dominate the community. As a consequence, aggregation 
     
    9586               !     Squared mortality of Phyto similar to a sedimentation term during 
    9687               !     blooms (Doney et al. 1996) 
    97                zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
     88               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
    9889 
    9990               !     Phytoplankton mortality. This mortality loss is slightly 
     
    119110               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    120111               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    121 #if defined key_kriest 
    122                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    123                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat 
    124                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
    125 #else 
    126112               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 
    127113               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 
     114               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
     115               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
    128116               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 
    129117               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 
    130 #endif 
    131118            END DO 
    132119         END DO 
     
    153140      INTEGER  ::  ji, jj, jk 
    154141      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    155       REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
     142      REAL(wp) ::  zrespp2, ztortp2, zmortp2 
    156143      REAL(wp) ::  zlim2, zlim1 
    157144      CHARACTER (len=25) :: charout 
     
    176163               !    sticky and coagulate to sink quickly out of the euphotic zone 
    177164               !     ------------------------------------------------------------ 
    178                zstep   = xstep 
    179 # if defined key_degrad 
    180                zstep = zstep * facvol(ji,jj,jk) 
    181 # endif 
    182165               !  Phytoplankton respiration  
    183166               !     ------------------------ 
    184167               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    185168               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    186                zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
     169               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
    187170 
    188171               !     Phytoplankton mortality.  
    189172               !     ------------------------ 
    190                ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
     173               ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
    191174 
    192175               zmortp2 = zrespp2 + ztortp2 
     
    202185               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    203186               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    204 #if defined key_kriest 
    205                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2   
    206                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr 
    207                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe 
    208 #else 
    209187               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 
    210188               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 
     189               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
     190               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
    211191               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 
    212192               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
    213 #endif 
    214193            END DO 
    215194         END DO 
     
    240219      !!---------------------------------------------------------------------- 
    241220 
    242       NAMELIST/nampismort/ wchl, wchld, wchldm, mprat, mprat2 
     221      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2 
    243222      INTEGER :: ios                 ! Local integer output status for namelist read 
    244223 
    245224      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton 
    246       READ  ( numnatp_ref, nampismort, IOSTAT = ios, ERR = 901) 
    247 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in reference namelist', lwp ) 
     225      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 
     226901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 
    248227 
    249228      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
    250       READ  ( numnatp_cfg, nampismort, IOSTAT = ios, ERR = 902 ) 
    251 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in configuration namelist', lwp ) 
    252       IF(lwm) WRITE ( numonp, nampismort ) 
     229      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 
     230902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 
     231      IF(lwm) WRITE ( numonp, namp4zmort ) 
    253232 
    254233      IF(lwp) THEN                         ! control print 
    255234         WRITE(numout,*) ' ' 
    256          WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort' 
     235         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort' 
    257236         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    258237         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl 
     
    265244   END SUBROUTINE p4z_mort_init 
    266245 
    267 #else 
    268    !!====================================================================== 
    269    !!  Dummy module :                                   No PISCES bio-model 
    270    !!====================================================================== 
    271 CONTAINS 
    272    SUBROUTINE p4z_mort                    ! Empty routine 
    273    END SUBROUTINE p4z_mort 
    274 #endif  
    275  
    276246   !!====================================================================== 
    277247END MODULE p4zmort 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r6962 r7646  
    99   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined  key_pisces 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces'                                       PISCES bio-model 
    14    !!---------------------------------------------------------------------- 
    1511   !!   p4z_opt       : light availability in the water column 
    1612   !!---------------------------------------------------------------------- 
     
    4137   INTEGER  :: ntimes_par                ! number of time steps in a file 
    4238   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave 
    43  
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat  
    45    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle 
    46    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
    4840 
    4941   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    5042 
    51    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
     43   REAL(wp), DIMENSION(3,61) ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5244    
    5345   !!---------------------------------------------------------------------- 
     
    7567      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    7668      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 
     69      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp5 
    7770      REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 
     71      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d 
    7972      !!--------------------------------------------------------------------- 
    8073      ! 
     
    8275      ! 
    8376      ! Allocate temporary workspace 
    84       CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
    85       CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    86       CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3 ) 
     77                   CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     78                   CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr ) 
     79      IF( ln_p5z ) CALL wrk_alloc( jpi, jpj,      zetmp5 ) 
     80                   CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3, zchl3d ) 
    8781 
    8882      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 
     
    9387      ze2(:,:,:) = 0._wp 
    9488      ze3(:,:,:) = 0._wp 
     89      ! 
    9590      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    96       DO jk = 1, jpkm1                         !  -------------------------------------------------------- 
     91                                               !  -------------------------------------------------------- 
     92                    zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
     93      IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 
     94      ! 
     95      DO jk = 1, jpkm1    
    9796         DO jj = 1, jpj 
    9897            DO ji = 1, jpi 
    99                zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
     98               zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
    10099               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    101100               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
     
    120119            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
    121120         END DO 
     121         IF( ln_p5z ) THEN 
     122            DO jk = 1, nksrp       
     123              epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     124            END DO 
     125         ENDIF 
    122126         ! 
    123127         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
     
    140144            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
    141145         END DO 
     146         IF( ln_p5z ) THEN 
     147            DO jk = 1, nksrp       
     148              epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     149            END DO 
     150         ENDIF 
    142151         etot_ndcy(:,:,:) =  etot(:,:,:)  
    143152      ENDIF 
     
    155164      ENDIF 
    156165      !                                        !* Euphotic depth and level 
    157       neln(:,:) = 1                            !  ------------------------ 
    158       heup(:,:) = 300. 
     166      neln   (:,:) = 1                            !  ------------------------ 
     167      heup   (:,:) = gdepw_n(:,:,2) 
     168      heup_01(:,:) = gdepw_n(:,:,2) 
    159169 
    160170      DO jk = 2, nksrp 
     
    166176                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    167177              ENDIF 
     178              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     179                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
     180              ENDIF 
    168181           END DO 
    169182        END DO 
    170183      END DO 
    171184      ! 
    172       heup(:,:) = MIN( 300., heup(:,:) ) 
     185      heup   (:,:) = MIN( 300., heup   (:,:) ) 
     186      heup_01(:,:) = MIN( 300., heup_01(:,:) ) 
    173187      !                                        !* mean light over the mixed layer 
    174188      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
     
    209223      END DO 
    210224      ! 
     225      IF( ln_p5z ) THEN 
     226         zetmp5 (:,:) = 0.e0 
     227         DO jk = 1, nksrp 
     228            DO jj = 1, jpj 
     229               DO ji = 1, jpi 
     230                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN  
     231                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     232                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     233                     epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     234                  ENDIF 
     235               END DO 
     236            END DO 
     237         END DO 
     238      ENDIF 
    211239      IF( lk_iomput ) THEN 
    212240        IF( knt == nrdttrc ) THEN 
     
    215243           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    216244        ENDIF 
    217       ELSE 
    218          IF( ln_diatrc ) THEN        ! save output diagnostics 
    219             trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1) 
    220             trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    221          ENDIF 
    222       ENDIF 
    223       ! 
    224       CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
    225       CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    226       CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3 ) 
     245      ENDIF 
     246      ! 
     247                   CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     248                   CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr ) 
     249      IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj,      zetmp5 ) 
     250                   CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3, zchl3d ) 
    227251      ! 
    228252      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
     
    407431                         enano    (:,:,:) = 0._wp 
    408432                         ediat    (:,:,:) = 0._wp 
     433      IF( ln_p5z     )   epico    (:,:,:) = 0._wp 
    409434      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp 
    410435      !  
     
    418443      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    419444      !!---------------------------------------------------------------------- 
    420       ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   & 
    421         &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), & 
    422         &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )  
    423          ! 
     445      ! 
     446      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 
     447                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc )  
     448      ! 
    424449      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
    425450      ! 
    426451   END FUNCTION p4z_opt_alloc 
    427  
    428 #else 
    429    !!---------------------------------------------------------------------- 
    430    !!  Dummy module :                                   No PISCES bio-model 
    431    !!---------------------------------------------------------------------- 
    432 CONTAINS 
    433    SUBROUTINE p4z_opt                   ! Empty routine 
    434    END SUBROUTINE p4z_opt 
    435 #endif  
    436452 
    437453   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r6945 r7646  
    88   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups 
    1511   !!   p4z_prod_init  :   Initialization of the parameters for growth 
     
    1915   USE trc             !  passive tracers common variables  
    2016   USE sms_pisces      !  PISCES Source Minus Sink variables 
    21    USE p4zopt          !  optical model 
    2217   USE p4zlim          !  Co-limitations of differents nutrients 
    2318   USE prtctl_trc      !  print control for debugging 
     
    3328   !! * Shared module variables 
    3429   LOGICAL , PUBLIC ::  ln_newprod      !: 
    35    REAL(wp), PUBLIC ::  pislope         !: 
    36    REAL(wp), PUBLIC ::  pislope2        !: 
     30   REAL(wp), PUBLIC ::  pislopen         !: 
     31   REAL(wp), PUBLIC ::  pisloped        !: 
    3732   REAL(wp), PUBLIC ::  xadap           !: 
    38    REAL(wp), PUBLIC ::  excret          !: 
    39    REAL(wp), PUBLIC ::  excret2         !: 
     33   REAL(wp), PUBLIC ::  excretn          !: 
     34   REAL(wp), PUBLIC ::  excretd         !: 
    4035   REAL(wp), PUBLIC ::  bresp           !: 
    4136   REAL(wp), PUBLIC ::  chlcnm          !: 
     
    5146    
    5247   REAL(wp) :: r1_rday                !: 1 / rday 
    53    REAL(wp) :: texcret                !: 1 - excret  
    54    REAL(wp) :: texcret2               !: 1 - excret2         
     48   REAL(wp) :: texcretn               !: 1 - excretn  
     49   REAL(wp) :: texcretd               !: 1 - excretd         
    5550 
    5651   !!---------------------------------------------------------------------- 
     
    7570      INTEGER  ::   ji, jj, jk 
    7671      REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 
    77       REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap 
    78       REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 
    79       REAL(wp) ::   zmxltst, zmxlday, zmaxday 
    80       REAL(wp) ::   zpislopen  , zpislope2n 
    81       REAL(wp) ::   zrum, zcodel, zargu, zval 
     72      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn 
     73      REAL(wp) ::   zprod, zproreg, zproreg2, zprochln, zprochld 
     74      REAL(wp) ::   zmaxday, zdocprod, zpislopen, zpisloped 
     75      REAL(wp) ::   zmxltst, zmxlday 
     76      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n 
    8277      REAL(wp) ::   zfact 
    8378      CHARACTER (len=25) :: charout 
    84       REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn, zw2d 
    85       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d    
    86       REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 
     79      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zw2d, zmixnano, zmixdiat 
     80      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d    
     81      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch    
     82      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd 
     84      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 
    8785      !!--------------------------------------------------------------------- 
    8886      ! 
     
    9088      ! 
    9189      !  Allocate temporary workspace 
    92       CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
    93       CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
    94       CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
    95       ! 
    96       zprorca (:,:,:) = 0._wp 
    97       zprorcad(:,:,:) = 0._wp 
    98       zprofed (:,:,:) = 0._wp 
    99       zprofen (:,:,:) = 0._wp 
    100       zprochln(:,:,:) = 0._wp 
    101       zprochld(:,:,:) = 0._wp 
    102       zpronew (:,:,:) = 0._wp 
    103       zpronewd(:,:,:) = 0._wp 
    104       zprdia  (:,:,:) = 0._wp 
    105       zprbio  (:,:,:) = 0._wp 
    106       zprdch  (:,:,:) = 0._wp 
    107       zprnch  (:,:,:) = 0._wp 
    108       zysopt  (:,:,:) = 0._wp 
     90      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn ) 
     91      CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )  
     92      CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 
     93      CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 
     94      ! 
     95      zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
     96      zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp 
     97      zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
     98      zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
     99      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp  
    109100 
    110101      ! Computation of the optimal production 
    111       prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)  
    112       IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)  
     102      prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)  
    113103 
    114104      ! compute the day length depending on latitude and the day 
     
    126116      END DO 
    127117 
    128       ! Impact of the day duration on phytoplankton growth 
     118      ! Impact of the day duration and light intermittency on phytoplankton growth 
    129119      DO jk = 1, jpkm1 
    130120         DO jj = 1 ,jpj 
     
    132122               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    133123                  zval = MAX( 1., zstrn(ji,jj) ) 
    134                   zval = 1.5 * zval / ( 12. + zval ) 
    135                   zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 
    136                   zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     124                  IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 
     125                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     126                  ENDIF 
     127                  zmxl_chl(ji,jj,jk) = zval / 24. 
     128                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    137129               ENDIF 
    138130            END DO 
    139131         END DO 
    140132      END DO 
     133 
     134      zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 
     135      zprdia(:,:,:) = zprbio(:,:,:) 
    141136 
    142137      ! Maximum light intensity 
    143138      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    144       zstrn(:,:) = 24. / zstrn(:,:) 
     139 
     140      ! Computation of the P-I slope for nanos and diatoms 
     141      DO jk = 1, jpkm1 
     142         DO jj = 1, jpj 
     143            DO ji = 1, jpi 
     144               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     145                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     146                  zadap       = xadap * ztn / ( 2.+ ztn ) 
     147                  zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
     148                  zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
     149                  ! 
     150                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
     151                  &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
     152                  ! 
     153                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
     154                  &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
     155               ENDIF 
     156            END DO 
     157         END DO 
     158      END DO 
    145159 
    146160      IF( ln_newprod ) THEN 
     
    148162            DO jj = 1, jpj 
    149163               DO ji = 1, jpi 
    150                   ! Computation of the P-I slope for nanos and diatoms 
    151164                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    152                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    153                       zadap       = xadap * ztn / ( 2.+ ztn ) 
    154                       zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    155                       zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    156                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
    157                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    158                       ! 
    159                       zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  & 
    160                          &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    161                       ! 
    162                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
    163                          &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    164  
    165165                      ! Computation of production function for Carbon 
    166166                      !  --------------------------------------------- 
    167                       zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 
    168                       zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 
    169                       zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
    170                       zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
    171  
     167                      zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     168                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     169                      zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     170                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     171                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     172                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    172173                      !  Computation of production function for Chlorophyll 
    173174                      !-------------------------------------------------- 
    174                       zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
    175                       zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
    176                       zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     175                      zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     176                      zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     177                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     178                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    177179                  ENDIF 
    178180               END DO 
     
    183185            DO jj = 1, jpj 
    184186               DO ji = 1, jpi 
    185  
    186                   ! Computation of the P-I slope for nanos and diatoms 
    187187                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    188                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    189                       zadap       = ztn / ( 2.+ ztn ) 
    190                       zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    191                       zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    192                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
    193                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    194                       ! 
    195                       zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) ) 
    196                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    197  
    198                       zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                & 
    199                         &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
    200                         &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    201  
    202                       zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                & 
    203                         &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
    204                         &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    205  
    206188                      ! Computation of production function for Carbon 
    207189                      !  --------------------------------------------- 
    208                       zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) ) 
    209                       zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 
    210  
     190                      zpislopen = zpislopeadn(ji,jj,jk)  / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     191                      zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     192                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     193                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    211194                      !  Computation of production function for Chlorophyll 
    212195                      !-------------------------------------------------- 
    213                       zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
    214                       zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     196                      zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     197                      zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     198                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     199                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    215200                  ENDIF 
    216201               END DO 
     
    218203         END DO 
    219204      ENDIF 
    220  
    221205 
    222206      !  Computation of a proxy of the N/C ratio 
     
    261245      END DO 
    262246 
    263       !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    264       DO jj = 1, jpj 
    265          DO ji = 1, jpi 
    266             zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 
    267             zmxlday = zmxltst * zmxltst * r1_rday 
    268             zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 
    269             zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 
    270          END DO 
    271       END DO 
    272   
    273       !  Mixed-layer effect on production                                                                                
    274       DO jk = 1, jpkm1 
    275          DO jj = 1, jpj 
    276             DO ji = 1, jpi 
    277                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    278                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 
    279                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 
    280                ENDIF 
     247      !  Mixed-layer effect on production  
     248      !  Sea-ice effect on production 
     249 
     250      DO jk = 1, jpkm1 
     251         DO jj = 1, jpj 
     252            DO ji = 1, jpi 
    281253               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    282254               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     255               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     256               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    283257            END DO 
    284258         END DO 
     
    290264            DO ji = 1, jpi 
    291265               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    292                   !  production terms for nanophyto. 
    293                   zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    294                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     266                  !  production terms for nanophyto. (C) 
     267                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
     268                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    295269                  ! 
    296                   zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    297                   zratio = zratio / fecnm  
     270                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 
    298271                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    299                   zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) & 
     272                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 
    300273                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    301274                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    302275                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2 
    303                   !  production terms for diatomees 
     276                  !  production terms for diatoms (C) 
    304277                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    305278                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    306279                  ! 
    307                   zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    308                   zratio = zratio / fecdm  
     280                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 
    309281                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    310                   zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) & 
     282                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 
    311283                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    312284                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
     
    317289      END DO 
    318290 
    319       DO jk = 1, jpkm1 
    320          DO jj = 1, jpj 
    321             DO ji = 1, jpi 
    322                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    323                   zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
    324                   zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
    325                ENDIF 
     291      ! Computation of the chlorophyll production terms 
     292      DO jk = 1, jpkm1 
     293         DO jj = 1, jpj 
     294            DO ji = 1, jpi 
    326295               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    327296                  !  production terms for nanophyto. ( chlorophyll ) 
    328                   znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
    329                   zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    330                   zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
    331                   zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 
    332                                      & (  zpislopead(ji,jj,jk) * znanotot +rtrn) 
    333                   !  production terms for diatomees ( chlorophyll ) 
    334                   zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
    335                   zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    336                   zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
    337                   zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 
    338                                      & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 
     297                  znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     298                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     299                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
     300                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     301                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
     302                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
     303                  !  production terms for diatoms ( chlorophyll ) 
     304                  zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     305                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     306                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
     307                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     308                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
     309                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
     310                  !   Update the arrays TRA which contain the Chla sources and sinks 
     311                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
     312                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    339313               ENDIF 
    340314            END DO 
     
    346320         DO jj = 1, jpj 
    347321           DO ji =1 ,jpi 
    348               zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 
    349               zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
    350               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    351               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 
    352               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
    353               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 
    354               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 
    355               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 
    356               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 
    357               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 
    358               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 
    359               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 
    360               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
    361               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
    362                  &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    363               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
    364               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    365               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    366               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
    367                  &                                      - rno3 * ( zproreg + zproreg2 ) 
    368           END DO 
     322              IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     323                 zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
     324                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
     325                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     326                 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     327                 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     328                 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
     329                 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 
     330                 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
     331                 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 
     332                 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
     333                 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     334                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 
     335                 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
     336                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     337                 ! 
     338                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     339                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
     340                 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     341                 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     342                 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     343                 &                                         - rno3 * ( zproreg + zproreg2 ) 
     344              ENDIF 
     345           END DO 
    369346        END DO 
    370347     END DO 
     348     ! 
     349     IF( ln_ligand ) THEN 
     350         DO jk = 1, jpkm1 
     351            DO jj = 1, jpj 
     352              DO ji =1 ,jpi 
     353                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     354                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     355                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     356                    tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     357                 ENDIF 
     358              END DO 
     359           END DO 
     360        END DO 
     361     ENDIF 
    371362 
    372363 
    373364    ! Total primary production per year 
    374365    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  & 
    375          & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
     366         & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    376367 
    377368    IF( lk_iomput ) THEN 
     
    381372          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    382373          ! 
    383           IF( iom_use( "PPPHY" ) .OR. iom_use( "PPPHY2" ) )  THEN 
    384               zw3d(:,:,:) = zprorca (:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
    385               CALL iom_put( "PPPHY"  , zw3d ) 
     374          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN 
     375              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
     376              CALL iom_put( "PPPHYN"  , zw3d ) 
    386377              ! 
    387378              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes 
    388               CALL iom_put( "PPPHY2"  , zw3d ) 
     379              CALL iom_put( "PPPHYD"  , zw3d ) 
    389380          ENDIF 
    390381          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN 
    391               zw3d(:,:,:) = zpronew (:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
     382              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
    392383              CALL iom_put( "PPNEWN"  , zw3d ) 
    393384              ! 
     
    425416          ENDIF 
    426417          IF( iom_use( "TPP" ) )  THEN 
    427               zw3d(:,:,:) = ( zprorca(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
     418              zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
    428419              CALL iom_put( "TPP"  , zw3d ) 
    429420          ENDIF 
    430421          IF( iom_use( "TPNEW" ) )  THEN 
    431               zw3d(:,:,:) = ( zpronew(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
     422              zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
    432423              CALL iom_put( "TPNEW"  , zw3d ) 
    433424          ENDIF 
     
    436427              CALL iom_put( "TPBFE"  , zw3d ) 
    437428          ENDIF 
    438           IF( iom_use( "INTPPPHY" ) .OR. iom_use( "INTPPPHY2" ) ) THEN   
     429          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN   
    439430             zw2d(:,:) = 0. 
    440431             DO jk = 1, jpkm1 
    441                zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     432               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    442433             ENDDO 
    443              CALL iom_put( "INTPPPHY" , zw2d ) 
     434             CALL iom_put( "INTPPPHYN" , zw2d ) 
    444435             ! 
    445436             zw2d(:,:) = 0. 
     
    447438                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    448439             ENDDO 
    449              CALL iom_put( "INTPPPHY2" , zw2d ) 
     440             CALL iom_put( "INTPPPHYD" , zw2d ) 
    450441          ENDIF 
    451442          IF( iom_use( "INTPP" ) ) THEN    
    452443             zw2d(:,:) = 0. 
    453444             DO jk = 1, jpkm1 
    454                 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     445                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    455446             ENDDO 
    456447             CALL iom_put( "INTPP" , zw2d ) 
     
    459450             zw2d(:,:) = 0. 
    460451             DO jk = 1, jpkm1 
    461                 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     452                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    462453             ENDDO 
    463454             CALL iom_put( "INTPNEW" , zw2d ) 
     
    482473          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    483474       ENDIF 
    484      ELSE 
    485         IF( ln_diatrc ) THEN 
    486            zfact = 1.e+3 * rfact2r 
    487            trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zfact * tmask(:,:,:) 
    488            trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zfact * tmask(:,:,:) 
    489            trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zfact * tmask(:,:,:) 
    490            trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zfact * tmask(:,:,:) 
    491            trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) 
    492            trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zfact * tmask(:,:,:) 
    493 #  if ! defined key_kriest 
    494            trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:) 
    495 #  endif 
    496         ENDIF 
    497475     ENDIF 
    498476 
     
    503481     ENDIF 
    504482     ! 
    505      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
    506      CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
    507      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     483     CALL wrk_dealloc( jpi, jpj,  zmixnano, zmixdiat,    zstrn ) 
     484     CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )  
     485     CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 
     486     CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 
    508487     ! 
    509488     IF( nn_timing == 1 )  CALL timing_stop('p4z_prod') 
     
    524503      !!---------------------------------------------------------------------- 
    525504      ! 
    526       NAMELIST/nampisprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2,  & 
     505      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd,  & 
    527506         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    528507      INTEGER :: ios                 ! Local integer output status for namelist read 
     
    530509 
    531510      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 
    532       READ  ( numnatp_ref, nampisprod, IOSTAT = ios, ERR = 901) 
    533 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in reference namelist', lwp ) 
     511      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 
     512901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 
    534513 
    535514      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 
    536       READ  ( numnatp_cfg, nampisprod, IOSTAT = ios, ERR = 902 ) 
    537 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in configuration namelist', lwp ) 
    538       IF(lwm) WRITE ( numonp, nampisprod ) 
     515      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 
     516902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 
     517      IF(lwm) WRITE ( numonp, namp4zprod ) 
    539518 
    540519      IF(lwp) THEN                         ! control print 
    541520         WRITE(numout,*) ' ' 
    542          WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 
     521         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 
    543522         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    544          WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod 
     523         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod 
    545524         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
    546          WRITE(numout,*) '    P-I slope                                 pislope      =', pislope 
    547          WRITE(numout,*) '    Acclimation factor to low light           xadap       =', xadap 
    548          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret 
    549          WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2 
     525         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen 
     526         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap 
     527         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn 
     528         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd 
    550529         IF( ln_newprod )  THEN 
    551530            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
    552531            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
    553532         ENDIF 
    554          WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2 
     533         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped 
    555534         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
    556535         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
     
    560539      ! 
    561540      r1_rday   = 1._wp / rday  
    562       texcret   = 1._wp - excret 
    563       texcret2  = 1._wp - excret2 
     541      texcretn  = 1._wp - excretn 
     542      texcretd  = 1._wp - excretd 
    564543      tpp       = 0._wp 
    565544      ! 
     
    576555      ! 
    577556   END FUNCTION p4z_prod_alloc 
    578  
    579 #else 
    580    !!====================================================================== 
    581    !!  Dummy module :                                   No PISCES bio-model 
    582    !!====================================================================== 
    583 CONTAINS 
    584    SUBROUTINE p4z_prod                    ! Empty routine 
    585    END SUBROUTINE p4z_prod 
    586 #endif  
    587  
    588557   !!====================================================================== 
    589558END MODULE p4zprod 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r6945 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_top'       and                                      TOP models 
    13    !!   'key_pisces'                                       PISCES bio-model 
    14    !!---------------------------------------------------------------------- 
    1510   !!   p4z_rem       :  Compute remineralization/dissolution of organic compounds 
    1611   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation 
     
    2015   USE trc             !  passive tracers common variables  
    2116   USE sms_pisces      !  PISCES Source Minus Sink variables 
    22    USE p4zopt          !  optical model 
    2317   USE p4zche          !  chemical model 
    2418   USE p4zprod         !  Growth rate of the 2 phyto groups 
    25    USE p4zmeso         !  Sources and sinks of mesozooplankton 
    26    USE p4zint          !  interpolation and computation of various fields 
    2719   USE p4zlim 
    2820   USE prtctl_trc      !  print control for debugging 
     
    3830 
    3931   !! * Shared module variables 
     32   REAL(wp), PUBLIC ::  xremikc    !: remineralisation rate of DOC  
     33   REAL(wp), PUBLIC ::  xremikn    !: remineralisation rate of DON  
     34   REAL(wp), PUBLIC ::  xremikp    !: remineralisation rate of DOP  
    4035   REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC  
    41    REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC 
    4236   REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate  
    4337   REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC  
    4438   REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC  
    4539   REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica  
    46  
     40   REAL(wp), PUBLIC ::  feratb     !: Fe/C quota in bacteria 
     41   REAL(wp), PUBLIC ::  xkferb     !: Half-saturation constant for bacteria Fe/C 
    4742 
    4843   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5044 
    5145   !!---------------------------------------------------------------------- 
     
    6862      ! 
    6963      INTEGER  ::   ji, jj, jk 
    70       REAL(wp) ::   zremip, zremik, zsiremin  
     64      REAL(wp) ::   zremik, zremikc, zremikn, zremikp, zsiremin, zfact  
    7165      REAL(wp) ::   zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 
    72       REAL(wp) ::   zbactfer, zorem, zorem2, zofer, zolimit 
    73       REAL(wp) ::   zosil, ztem 
    74 #if ! defined key_kriest 
    75       REAL(wp) ::   zofer2 
    76 #endif 
    77       REAL(wp) ::   zonitr, zstep, zfact 
     66      REAL(wp) ::   zbactfer, zolimit, zonitr, zrfact2 
     67      REAL(wp) ::   zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 
    7868      CHARACTER (len=25) :: charout 
    7969      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac