New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

Location:
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
Files:
20 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r2715 r3294  
    1414   !!                      compartments of PISCES 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! 
    17    USE trc         !  
    18    USE sms_pisces      !  
    19    USE p4zsink         !  
    20    USE p4zopt          !  
    21    USE p4zlim          !  
    22    USE p4zprod         ! 
    23    USE p4zmort         ! 
    24    USE p4zmicro        !  
    25    USE p4zmeso         !  
    26    USE p4zrem          !  
    27    USE prtctl_trc 
    28    USE iom 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE p4zopt          !  optical model 
     21   USE p4zlim          !  Co-limitations of differents nutrients 
     22   USE p4zprod         !  Growth rate of the 2 phyto groups 
     23   USE p4zmort         !  Mortality terms for phytoplankton 
     24   USE p4zmicro        !  Sources and sinks of microzooplankton 
     25   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     26   USE p4zrem          !  Remineralisation of organic matter 
     27   USE prtctl_trc      !  print control for debugging 
     28   USE iom             !  I/O manager 
    2929   
    3030   IMPLICIT NONE 
     
    6262 
    6363      !!--------------------------------------------------------------------- 
    64  
     64      ! 
     65      IF( nn_timing == 1 )  CALL timing_start('p4z_bio') 
     66      ! 
    6567      !     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 
    6668      !     OF PHYTOPLANKTON AND DETRITUS 
     
    129131      ENDIF 
    130132      ! 
     133      IF( nn_timing == 1 )  CALL timing_stop('p4z_bio') 
     134      ! 
    131135   END SUBROUTINE p4z_bio 
    132136 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2715 r3294  
    1010   !!              -   !  2006     (R. Gangsto)  modification 
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     12   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_pisces 
     
    1718   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
    1819   !!---------------------------------------------------------------------- 
    19    USE oce_trc       ! 
    20    USE trc           ! 
    21    USE sms_pisces    !  
    22    USE lib_mpp       ! MPP library 
     20   USE oce_trc       !  shared variables between ocean and passive tracers 
     21   USE trc           !  passive tracers common variables 
     22   USE sms_pisces    !  PISCES Source Minus Sink variables 
     23   USE lib_mpp       !  MPP library 
    2324 
    2425   IMPLICIT NONE 
     
    3233   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
    3334 
    34    REAL(wp) ::   salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    35  
    36    REAL(wp) ::   akcc1 = -171.9065_wp      ! coeff. for apparent solubility equilibrium 
    37    REAL(wp) ::   akcc2 =   -0.077993_wp    ! Millero et al. 1995 from Mucci 1983 
    38    REAL(wp) ::   akcc3 = 2839.319_wp       ! 
    39    REAL(wp) ::   akcc4 =   71.595_wp       ! 
    40    REAL(wp) ::   akcc5 =   -0.77712_wp     ! 
    41    REAL(wp) ::   akcc6 =    0.0028426_wp   ! 
    42    REAL(wp) ::   akcc7 =  178.34_wp        ! 
    43    REAL(wp) ::   akcc8 =   -0.07711_wp     ! 
    44    REAL(wp) ::   akcc9 =    0.0041249_wp   ! 
    45  
    46    REAL(wp) ::   rgas  = 83.143_wp         ! universal gas constants 
    47    REAL(wp) ::   oxyco = 1._wp / 22.4144_wp 
    48  
    49    REAL(wp) ::   bor1 = 0.00023_wp         ! borat constants 
    50    REAL(wp) ::   bor2 = 1._wp / 10.82_wp 
    51  
    52    REAL(wp) ::   ca0 = -162.8301_wp 
    53    REAL(wp) ::   ca1 =  218.2968_wp 
    54    REAL(wp) ::   ca2 =   90.9241_wp 
    55    REAL(wp) ::   ca3 =   -1.47696_wp 
    56    REAL(wp) ::   ca4 =    0.025695_wp 
    57    REAL(wp) ::   ca5 =   -0.025225_wp 
    58    REAL(wp) ::   ca6 =    0.0049867_wp 
    59  
    60    REAL(wp) ::   c10 = -3670.7_wp        ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
    61    REAL(wp) ::   c11 =    62.008_wp      
    62    REAL(wp) ::   c12 =    -9.7944_wp     
    63    REAL(wp) ::   c13 =     0.0118_wp      
    64    REAL(wp) ::   c14 =    -0.000116_wp 
    65  
    66    REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
    67       c20 = -1394.7   , & 
    68       c21 = -4.777    , & 
    69       c22 = 0.0184    , & 
    70       c23 = -0.000118 
    71  
    72    REAL(wp) :: &             ! constants for calculate concentrations  
    73       st1  = 0.14     , &    ! for sulfate (Morris & Riley 1966) 
    74       st2  = 1./96.062, & 
    75       ks0  = 141.328  , & 
    76       ks1  = -4276.1  , & 
    77       ks2  = -23.093  , & 
    78       ks3  = -13856.  , & 
    79       ks4  = 324.57   , & 
    80       ks5  = -47.986  , & 
    81       ks6  = 35474.   , & 
    82       ks7  = -771.54  , & 
    83       ks8  = 114.723  , & 
    84       ks9  = -2698.   , & 
    85       ks10 = 1776.    , & 
    86       ks11 = 1.       , & 
    87       ks12 = -0.001005  
    88  
    89    REAL(wp) :: &             ! constants for calculate concentrations  
    90       ft1  = 0.000067   , &  ! fluorides (Dickson & Riley 1979 ) 
    91       ft2  = 1./18.9984 , & 
    92       kf0  = -12.641    , & 
    93       kf1  = 1590.2     , & 
    94       kf2  = 1.525      , & 
    95       kf3  = 1.0        , & 
    96       kf4  =-0.001005 
    97  
    98    REAL(wp) :: &              ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 
    99       cb0  = -8966.90, & 
    100       cb1  = -2890.53, & 
    101       cb2  = -77.942 , & 
    102       cb3  = 1.728   , & 
    103       cb4  = -0.0996 , & 
    104       cb5  = 148.0248, & 
    105       cb6  = 137.1942, & 
    106       cb7  = 1.62142 , & 
    107       cb8  = -24.4344, & 
    108       cb9  = -25.085 , & 
    109       cb10 = -0.2474 , & 
    110       cb11 = 0.053105 
    111  
    112    REAL(wp) :: &             ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
    113       cw0 = -13847.26  , & 
    114       cw1 = 148.9652   , & 
    115       cw2 = -23.6521   , & 
    116       cw3 = 118.67     , & 
    117       cw4 = -5.977     , & 
    118       cw5 = 1.0495     , & 
    119       cw6 = -0.01615 
    120   
    121    REAL(wp) :: &              ! volumetric solubility constants for o2 in ml/l (Weiss, 1974) 
    122       ox0 = -58.3877   , & 
    123       ox1 = 85.8079    , & 
    124       ox2 = 23.8439    , & 
    125       ox3 = -0.034892  , & 
    126       ox4 =  0.015568  , & 
    127       ox5 = -0.0019387  
    128  
    129    REAL(wp), DIMENSION(5)  :: &  ! coeff. for seawater pressure correction  
    130       devk1, devk2, devk3,    &  ! (millero 95) 
    131       devk4, devk5 
    132  
     35   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm 
     36 
     37   REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
     38   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )   
     39 
     40   REAL(wp) ::   akcc1  = -171.9065       ! coeff. for apparent solubility equilibrium 
     41   REAL(wp) ::   akcc2  =   -0.077993     ! Millero et al. 1995 from Mucci 1983 
     42   REAL(wp) ::   akcc3  = 2839.319         
     43   REAL(wp) ::   akcc4  =   71.595         
     44   REAL(wp) ::   akcc5  =   -0.77712       
     45   REAL(wp) ::   akcc6  =    0.00284263    
     46   REAL(wp) ::   akcc7  =  178.34         
     47   REAL(wp) ::   akcc8  =   -0.07711      
     48   REAL(wp) ::   akcc9  =    0.0041249    
     49 
     50   REAL(wp) ::   rgas   = 83.143         ! universal gas constants 
     51   REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles 
     52 
     53   REAL(wp) ::   bor1   = 0.00023        ! borat constants 
     54   REAL(wp) ::   bor2   = 1. / 10.82 
     55 
     56   REAL(wp) ::   ca0    = -162.8301      ! WEISS & PRICE 1980, units mol/(kg atm) 
     57   REAL(wp) ::   ca1    =  218.2968 
     58   REAL(wp) ::   ca2    =   90.9241 
     59   REAL(wp) ::   ca3    =   -1.47696 
     60   REAL(wp) ::   ca4    =    0.025695 
     61   REAL(wp) ::   ca5    =   -0.025225 
     62   REAL(wp) ::   ca6    =    0.0049867 
     63 
     64   REAL(wp) ::   c10    = -3670.7        ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
     65   REAL(wp) ::   c11    =    62.008      
     66   REAL(wp) ::   c12    =    -9.7944     
     67   REAL(wp) ::   c13    =     0.0118      
     68   REAL(wp) ::   c14    =    -0.000116 
     69 
     70   REAL(wp) ::   c20    = -1394.7       ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
     71   REAL(wp) ::   c21    =    -4.777    
     72   REAL(wp) ::   c22    =     0.0184    
     73   REAL(wp) ::   c23    =    -0.000118 
     74 
     75   REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate 
     76   REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966) 
     77   REAL(wp) ::   ks0    =    141.328  
     78   REAL(wp) ::   ks1    =  -4276.1   
     79   REAL(wp) ::   ks2    =    -23.093 
     80   REAL(wp) ::   ks3    = -13856.   
     81   REAL(wp) ::   ks4    =   324.57  
     82   REAL(wp) ::   ks5    =   -47.986 
     83   REAL(wp) ::   ks6    =  35474.  
     84   REAL(wp) ::   ks7    =   -771.54 
     85   REAL(wp) ::   ks8    =    114.723 
     86   REAL(wp) ::   ks9    =  -2698.   
     87   REAL(wp) ::   ks10   =   1776.  
     88   REAL(wp) ::   ks11   =      1. 
     89   REAL(wp) ::   ks12   =     -0.001005  
     90 
     91   REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides 
     92   REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 ) 
     93   REAL(wp) ::   kf0    =  -12.641     
     94   REAL(wp) ::   kf1    = 1590.2     
     95   REAL(wp) ::   kf2    =    1.525     
     96   REAL(wp) ::   kf3    =    1.0      
     97   REAL(wp) ::   kf4    =   -0.001005 
     98 
     99   REAL(wp) ::   cb0    = -8966.90      ! Coeff. for 1. dissoc. of boric acid  
     100   REAL(wp) ::   cb1    = -2890.53      ! (Dickson and Goyet, 1994) 
     101   REAL(wp) ::   cb2    =   -77.942 
     102   REAL(wp) ::   cb3    =     1.728 
     103   REAL(wp) ::   cb4    =    -0.0996 
     104   REAL(wp) ::   cb5    =   148.0248 
     105   REAL(wp) ::   cb6    =   137.1942 
     106   REAL(wp) ::   cb7    =     1.62142 
     107   REAL(wp) ::   cb8    =   -24.4344 
     108   REAL(wp) ::   cb9    =   -25.085 
     109   REAL(wp) ::   cb10   =    -0.2474  
     110   REAL(wp) ::   cb11   =     0.053105 
     111 
     112   REAL(wp) ::   cw0    = -13847.26     ! Coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
     113   REAL(wp) ::   cw1    =    148.9652   
     114   REAL(wp) ::   cw2    =    -23.6521 
     115   REAL(wp) ::   cw3    =    118.67  
     116   REAL(wp) ::   cw4    =     -5.977  
     117   REAL(wp) ::   cw5    =      1.0495   
     118   REAL(wp) ::   cw6    =     -0.01615 
     119 
     120   !                                    ! volumetric solubility constants for o2 in ml/L   
     121   REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 
     122   REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure 
     123   REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but  
     124   REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 
     125   REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 
     126   REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension. 
     127   REAL(wp) ::   ox6    = -6.24097e-3    
     128   REAL(wp) ::   ox7    = -6.93498e-3  
     129   REAL(wp) ::   ox8    = -6.90358e-3 
     130   REAL(wp) ::   ox9    = -4.29155e-3  
     131   REAL(wp) ::   ox10   = -3.11680e-7  
     132 
     133   REAL(wp), DIMENSION(5)  :: devk1, devk2, devk3, devk4, devk5   ! coeff. for seawater pressure correction  
     134   !                                                              ! (millero 95) 
    133135   DATA devk1 / -25.5    , -15.82    , -29.48  , -25.60     , -48.76    /    
    134136   DATA devk2 / 0.1271   , -0.0219   , 0.1622  , 0.2324     , 0.5304    /    
     
    155157      !!--------------------------------------------------------------------- 
    156158      INTEGER  ::   ji, jj, jk 
    157       REAL(wp) ::   ztkel, zsal , zqtt  , zbuf1 , zbuf2 
     159      REAL(wp) ::   ztkel, zt   , zt2   , zsal  , zsal2 , zbuf1 , zbuf2 
     160      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 
    158161      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
    159162      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1 
    160       REAL(wp) ::   zlqtt, zqtt2, zsal15, zis   , zis2 , zisqrt 
     163      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt 
    161164      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
    162165      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
    163166      !!--------------------------------------------------------------------- 
    164  
     167      ! 
     168      IF( nn_timing == 1 )  CALL timing_start('p4z_che') 
     169      ! 
    165170      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    166171      ! ---------------------------------- 
     
    171176            !                             ! SET ABSOLUTE TEMPERATURE 
    172177            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
    173             zqtt  = ztkel * 0.01 
    174             zqtt2 = zqtt * zqtt 
    175             zsal  = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35. 
    176             zlqtt = LOG( zqtt ) 
    177  
     178            z  = ztkel * 0.01 
     179            zt2   = zt * zt 
     180            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     181            zsal2 = zsal * zsal 
     182            zlogt = LOG( zt ) 
    178183            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    179184            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    180             zcek1 = ca0 + ca1 / zqtt + ca2 * zlqtt + ca3 * zqtt2 + zsal*( ca4 + ca5 * zqtt + ca6 * zqtt2 ) 
    181  
    182             !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 (EQ. 4, WEISS, 1970) 
    183             zoxy  = ox0 + ox1 / zqtt + ox2 * zlqtt + zsal * ( ox3 + ox4 * zqtt + ox5 * zqtt2 ) 
    184  
    185             !                             ! SET SOLUBILITIES OF O2 AND CO2 
    186             chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 
    187             chemc(ji,jj,2) = EXP( zoxy  ) * oxyco 
    188  
     185            zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 
     186            !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992) 
     187            ztgg  = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
     188            ztgg2 = ztgg  * ztgg 
     189            ztgg3 = ztgg2 * ztgg 
     190            ztgg4 = ztgg3 * ztgg 
     191            ztgg5 = ztgg4 * ztgg 
     192            zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   & 
     193                   + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2 
     194 
     195            !                             ! SET SOLUBILITIES OF O2 AND CO2  
     196            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm) 
     197            chemc(ji,jj,2) = ( EXP( zoxy  ) * o2atm ) * oxyco              ! mol/(L atm) 
     198            ! 
    189199         END DO 
    190200      END DO 
     
    204214               ! SET ABSOLUTE TEMPERATURE 
    205215               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16 
    206                zqtt    = ztkel * 0.01 
    207216               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    208217               zsqrt  = SQRT( zsal ) 
     
    311320      END DO 
    312321      ! 
     322      IF( nn_timing == 1 )  CALL timing_stop('p4z_che') 
     323      ! 
    313324   END SUBROUTINE p4z_che 
    314325 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2715 r3294  
    99   !!             1.0  !  2004     (O. Aumont) modifications 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_pisces 
     
    1617   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    1718   !!   p4z_flx_init  :   Read the namelist 
    18    !!---------------------------------------------------------------------- 
    19    USE trc 
    20    USE oce_trc         ! 
    21    USE trc 
    22    USE sms_pisces 
    23    USE prtctl_trc 
    24    USE p4zche 
    25    USE iom 
     19   !!   p4z_patm      :   Read sfc atm pressure [atm] for each grid cell 
     20   !!---------------------------------------------------------------------- 
     21   USE oce_trc                      !  shared variables between ocean and passive tracers  
     22   USE trc                          !  passive tracers common variables 
     23   USE sms_pisces                   !  PISCES Source Minus Sink variables 
     24   USE p4zche                       !  Chemical model 
     25   USE prtctl_trc                   !  print control for debugging 
     26   USE iom                          !  I/O manager 
     27   USE fldread                      !  read input fields 
    2628#if defined key_cpl_carbon_cycle 
    27    USE sbc_oce , ONLY :  atm_co2 
     29   USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2                
    2830#endif 
    2931 
     
    3537   PUBLIC   p4z_flx_alloc   
    3638 
     39   !                                      !!** Namelist  nampisext  ** 
     40   REAL(wp)          ::  atcco2    = 278._wp       !: pre-industrial atmospheric [co2] (ppm)     
     41   LOGICAL           ::  ln_co2int = .FALSE.       !: flag to read in a file and interpolate atmospheric pco2 or not 
     42   CHARACTER(len=34) ::  clname    = 'atcco2.txt'  !: filename of pco2 values 
     43   INTEGER           ::  nn_offset = 0             !: Offset model-data start year (default = 0)  
     44 
     45   !!  Variables related to reading atmospheric CO2 time history     
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years 
     47   INTEGER  :: nmaxrec, numco2 
     48 
     49   !                                         !!* nampisatm namelist (Atmospheric PRessure) * 
     50   LOGICAL, PUBLIC ::   ln_presatm = .true.  !: 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 
    3756   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
    3857   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
     
    4160   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2 
    4261   REAL(wp) ::  area                        !: ocean surface 
    43    REAL(wp) ::  atcco2 = 278._wp            !: pre-industrial atmospheric [co2] (ppm)   
    44    REAL(wp) ::  atcox  = 0.20946_wp         !: 
    4562   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    4663 
     
    6077      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    6178      !! 
    62       !! ** Method  : - ??? 
     79      !! ** Method  :  
     80      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
     81      !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
     82      !!              - Remove Wanninkhof chemical enhancement; 
     83      !!              - Add option for time-interpolation of atcco2.txt   
    6384      !!--------------------------------------------------------------------- 
    64       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    65       USE wrk_nemo, ONLY:   zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_3  
    66       USE wrk_nemo, ONLY:   zoflx  => wrk_2d_4 , zkg   => wrk_2d_5 
    67       USE wrk_nemo, ONLY:   zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_7 
    6885      ! 
    6986      INTEGER, INTENT(in) ::   kt   ! 
    7087      ! 
    71       INTEGER  ::   ji, jj, jrorr 
     88      INTEGER  ::   ji, jj, jm, iind, iindm1 
    7289      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    7390      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    7491      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     92      REAL(wp) ::   zyr_dec, zdco2dt 
    7593      CHARACTER (len=25) :: charout 
     94      REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx  
    7695      !!--------------------------------------------------------------------- 
    77  
    78       IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
    79          CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;   RETURN 
    80       ENDIF 
     96      ! 
     97      IF( nn_timing == 1 )  CALL timing_start('p4z_flx') 
     98      ! 
     99      CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 
     100      ! 
    81101 
    82102      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
     
    84104      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    85105 
     106      IF( kt /= nit000 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     107 
     108      IF( ln_co2int ) THEN  
     109         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
     110         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
     111         ! For nn_offset, if your model year is iyy, nn_offset=(years(1)-iyy)  
     112         ! then the first atmospheric CO2 record read is at years(1) 
     113         zyr_dec = REAL( nyear + nn_offset, wp ) + REAL( nday_year, wp ) / REAL( nyear_len(1), wp ) 
     114         jm = 2 
     115         DO WHILE( jm <= nmaxrec .AND. years(jm-1) < zyr_dec .AND. years(jm) >= zyr_dec ) ;  jm = jm + 1 ;  END DO 
     116         iind = jm  ;   iindm1 = jm - 1 
     117         zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 
     118         atcco2  = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 
     119         satmco2(:,:) = atcco2  
     120      ENDIF 
     121 
    86122#if defined key_cpl_carbon_cycle 
    87123      satmco2(:,:) = atm_co2(:,:) 
    88124#endif 
    89125 
    90       DO jrorr = 1, 10 
    91  
     126      DO jm = 1, 10 
    92127!CDIR NOVERRCHK 
    93128         DO jj = 1, jpj 
     
    137172            ! Compute the piston velocity for O2 and CO2 
    138173            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
     174            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    139175# if defined key_degrad 
    140             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 
    141 #else 
    142             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     176            zkgwan = zkgwan * facvol(ji,jj,1) 
    143177#endif  
    144178            ! compute gas exchange for CO2 and O2 
     
    151185         DO ji = 1, jpi 
    152186            ! Compute CO2 flux for the sea and air 
    153             zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    154             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
     187            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
     188            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    155189            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    156190            ! compute the trend 
     
    158192 
    159193            ! Compute O2 flux  
    160             zfld16 = atcox * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) 
     194            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    161195            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    162             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    163  
    164 #if defined key_diatrc  
    165             ! Save diagnostics 
    166 #  if ! defined key_iomput 
    167             zfact = 1. / e1e2t(ji,jj) / rfact 
    168             trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    169             trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    170             trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    171             trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
    172                &                            * tmask(ji,jj,1) 
    173 #  else 
    174             zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    175             zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    176             zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
    177             zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 
    178 #  endif 
    179 #endif 
     196            zoflx(ji,jj) = zfld16 - zflu16 
     197            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1) 
    180198         END DO 
    181199      END DO 
    182200 
    183       t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
     201      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )            ! Cumulative Total Flux of Carbon 
    184202      IF( kt == nitend ) THEN 
    185          t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
    186          ! 
    187          t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
    188          t_atm_co2_flx = t_atm_co2_flx  / area                                     ! global mean of atmospheric pCO2 
     203         t_atm_co2_flx = glob_sum( satmco2(:,:) * patm(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
     204         ! 
     205         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15             ! Conversion in PgC ; negative for out of the ocean 
     206         t_atm_co2_flx = t_atm_co2_flx  / area                            ! global mean of atmospheric pCO2 
    189207         ! 
    190208         IF( lwp) THEN 
     
    205223      ENDIF 
    206224 
    207 # if defined key_diatrc && defined key_iomput 
    208       CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
    209       CALL iom_put( "Oflx" , zoflx  ) 
    210       CALL iom_put( "Kg"   , zkg    ) 
    211       CALL iom_put( "Dpco2", zdpco2 ) 
    212       CALL iom_put( "Dpo2" , zdpo2  ) 
    213 #endif 
    214       ! 
    215       IF( wrk_not_released(2, 1,2,3,4,5,6,7) )   CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     225      IF( ln_diatrc ) THEN 
     226         IF( lk_iomput ) THEN 
     227            CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
     228            CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1)  ) 
     229            CALL iom_put( "Kg"   , zkgco2(:,:) * tmask(:,:,1) ) 
     230            CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     231            CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) ) 
     232         ELSE 
     233            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact  
     234            trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
     235            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
     236            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)  
     237         ENDIF 
     238      ENDIF 
     239      ! 
     240      CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 
     241      ! 
     242      IF( nn_timing == 1 )  CALL timing_stop('p4z_flx') 
    216243      ! 
    217244   END SUBROUTINE p4z_flx 
     
    225252      !! 
    226253      !! ** Method  :   Read the nampisext namelist and check the parameters 
    227       !!      called at the first timestep (nit000) 
     254      !!      called at the first timestep (nittrc000) 
    228255      !! ** input   :   Namelist nampisext 
    229256      !!---------------------------------------------------------------------- 
    230       NAMELIST/nampisext/ atcco2 
    231       !!---------------------------------------------------------------------- 
    232       ! 
    233       REWIND( numnat )                     ! read numnat 
    234       READ  ( numnat, nampisext ) 
     257      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 
     258      INTEGER :: jm 
     259      !!---------------------------------------------------------------------- 
     260      ! 
     261      REWIND( numnatp )                     ! read numnatp 
     262      READ  ( numnatp, nampisext ) 
    235263      ! 
    236264      IF(lwp) THEN                         ! control print 
     
    238266         WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 
    239267         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    240          WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
     268         WRITE(numout,*) '    Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 
     269         WRITE(numout,*) ' ' 
     270      ENDIF 
     271      IF( .NOT.ln_co2int ) THEN 
     272         IF(lwp) THEN                         ! control print 
     273            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
     274            WRITE(numout,*) ' ' 
     275         ENDIF 
     276         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
     277      ELSE 
     278         IF(lwp)  THEN 
     279            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
     280            WRITE(numout,*) '    Offset model-data start year      nn_offset   =', nn_offset 
     281            WRITE(numout,*) ' ' 
     282         ENDIF 
     283         CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) 
     284         jm = 0                      ! Count the number of record in co2 file 
     285         DO 
     286           READ(numco2,*,END=100)  
     287           jm = jm + 1 
     288         END DO 
     289 100     nmaxrec = jm - 1  
     290         ALLOCATE( years  (nmaxrec) )     ;      years  (:) = 0._wp 
     291         ALLOCATE( atcco2h(nmaxrec) )     ;      atcco2h(:) = 0._wp 
     292 
     293         REWIND(numco2) 
     294         DO jm = 1, nmaxrec          ! get  xCO2 data 
     295            READ(numco2, *)  years(jm), atcco2h(jm) 
     296            IF(lwp) WRITE(numout, '(f6.0,f7.2)')  years(jm), atcco2h(jm) 
     297         END DO 
     298         CLOSE(numco2) 
    241299      ENDIF 
    242300      ! 
     
    245303      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    246304      t_atm_co2_flx = 0._wp 
    247       ! 
    248       satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    249305      t_oce_co2_flx = 0._wp 
    250306      ! 
     307      CALL p4z_patm( nit000 ) 
     308      ! 
    251309   END SUBROUTINE p4z_flx_init 
    252310 
     311   SUBROUTINE p4z_patm( kt ) 
     312 
     313      !!---------------------------------------------------------------------- 
     314      !!                  ***  ROUTINE p4z_atm  *** 
     315      !! 
     316      !! ** Purpose :   Read and interpolate the external atmospheric sea-levl pressure 
     317      !! ** Method  :   Read the files and interpolate the appropriate variables 
     318      !! 
     319      !!---------------------------------------------------------------------- 
     320      !! * arguments 
     321      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     322      ! 
     323      INTEGER            ::  ierr 
     324      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
     325      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
     326      !! 
     327      NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 
     328 
     329      !                                         ! -------------------- ! 
     330      IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 ! 
     331         !                                      ! -------------------- ! 
     332         !                                            !* set file information (default values) 
     333         ! ... default values (NB: frequency positive => hours, negative => months) 
     334         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     335         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     336         sn_patm = FLD_N( 'pres'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       ) 
     337         cn_dir  = './'          ! directory in which the Patm data are  
     338 
     339         REWIND( numnatp )                             !* read in namlist nampisatm 
     340         READ  ( numnatp, nampisatm )  
     341         ! 
     342         ! 
     343         IF(lwp) THEN                                 !* control print 
     344            WRITE(numout,*) 
     345            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
     346            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
     347            WRITE(numout,*) 
     348         ENDIF 
     349         ! 
     350         IF( ln_presatm ) THEN 
     351            ALLOCATE( sf_patm(1), STAT=ierr )           !* allocate and fill sf_patm (forcing structure) with sn_patm 
     352            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_patm structure' ) 
     353            ! 
     354            CALL fld_fill( sf_patm, (/ sn_patm /), cn_dir, 'p4z_flx', 'Atmospheric pressure ', 'nampisatm' ) 
     355                                   ALLOCATE( sf_patm(1)%fnow(jpi,jpj,1)   ) 
     356            IF( sn_patm%ln_tint )  ALLOCATE( sf_patm(1)%fdta(jpi,jpj,1,2) ) 
     357         ENDIF 
     358         !                                          
     359         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
     360         ! 
     361      ENDIF 
     362      ! 
     363      IF( ln_presatm ) THEN 
     364         CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2 
     365         patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure 
     366      ENDIF 
     367      ! 
     368   END SUBROUTINE p4z_patm 
    253369 
    254370   INTEGER FUNCTION p4z_flx_alloc() 
     
    256372      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    257373      !!---------------------------------------------------------------------- 
    258       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
     374      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    259375      ! 
    260376      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2715 r3294  
    1313   !!   p4z_int        :  interpolation and computation of various accessory fields 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
    16    USE trc 
    17    USE sms_pisces 
     15   USE oce_trc         !  shared variables between ocean and passive tracers 
     16   USE trc             !  passive tracers common variables  
     17   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818 
    1919   IMPLICIT NONE 
     
    2121 
    2222   PUBLIC   p4z_int   
    23    PUBLIC   p4z_int_alloc 
    24  
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    27  
    2823   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    2924 
     
    4136      !! ** Purpose :   interpolation and computation of various accessory fields 
    4237      !! 
    43       !! ** Method  : - ??? 
    4438      !!--------------------------------------------------------------------- 
    45       INTEGER  ::   ji, jj 
    46       REAL(wp) ::   zdum 
     39      INTEGER  ::   ji, jj                 ! dummy loop indices 
     40      REAL(wp) ::   zvar                   ! local variable 
    4741      !!--------------------------------------------------------------------- 
    48  
     42      ! 
     43      IF( nn_timing == 1 )  CALL timing_start('p4z_int') 
     44      ! 
    4945      ! Computation of phyto and zoo metabolic rate 
    5046      ! ------------------------------------------- 
     
    5753      DO ji = 1, jpi 
    5854         DO jj = 1, jpj 
    59             zdum = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
    60             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zdum / ( xksilim * xksilim + zdum ) ) * 1e-6 ) 
     55            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
     56            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    6157         END DO 
    6258      END DO 
     
    6763      ENDIF 
    6864      ! 
     65      IF( nn_timing == 1 )  CALL timing_stop('p4z_int') 
     66      ! 
    6967   END SUBROUTINE p4z_int 
    70  
    71  
    72    INTEGER FUNCTION p4z_int_alloc() 
    73       !!---------------------------------------------------------------------- 
    74       !!                     ***  ROUTINE p4z_int_alloc  *** 
    75       !!---------------------------------------------------------------------- 
    76       ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
    77       ! 
    78       IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
    79       ! 
    80    END FUNCTION p4z_int_alloc 
    8168 
    8269#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r2528 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota  
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_lim_init   :   Read the namelist  
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
     17   USE oce_trc         ! Shared ocean-passive tracers variables 
     18   USE trc             ! Tracers defined 
     19   USE sms_pisces      ! PISCES variables 
     20   USE p4zopt          ! Optical 
    2021 
    2122   IMPLICIT NONE 
     
    2627 
    2728   !! * Shared module variables 
    28    REAL(wp), PUBLIC ::   & 
    29      conc0     = 2.e-6_wp      ,  &  !: 
    30      conc1     = 10.e-6_wp     ,  &  !: 
    31      conc2     = 2.e-11_wp     ,  &  !: 
    32      conc2m    = 8.E-11_wp     ,  &  !: 
    33      conc3     = 1.e-10_wp     ,  &  !: 
    34      conc3m    = 4.e-10_wp     ,  &  !: 
    35      concnnh4  = 1.e-7_wp      ,  &  !: 
    36      concdnh4  = 5.e-7_wp      ,  &  !: 
    37      xksi1     = 2.E-6_wp      ,  &  !: 
    38      xksi2     = 3.33E-6_wp    ,  &  !: 
    39      xkdoc     = 417.E-6_wp    ,  &  !: 
    40      caco3r    = 0.3_wp              !: 
    41  
    42  
     29   REAL(wp), PUBLIC ::  conc0     = 2.e-6_wp      !:  NO3, PO4 half saturation    
     30   REAL(wp), PUBLIC ::  conc1     = 8.e-6_wp      !:  Phosphate half saturation for diatoms   
     31   REAL(wp), PUBLIC ::  conc2     = 1.e-9_wp      !:  Iron half saturation for nanophyto  
     32   REAL(wp), PUBLIC ::  conc2m    = 3.e-9_wp      !:  Max iron half saturation for nanophyto  
     33   REAL(wp), PUBLIC ::  conc3     = 2.e-9_wp      !:  Iron half saturation for diatoms   
     34   REAL(wp), PUBLIC ::  conc3m    = 8.e-9_wp      !:  Max iron half saturation for diatoms  
     35   REAL(wp), PUBLIC ::  xsizedia  = 5.e-7_wp      !:  Minimum size criteria for diatoms 
     36   REAL(wp), PUBLIC ::  xsizephy  = 1.e-6_wp      !:  Minimum size criteria for nanophyto 
     37   REAL(wp), PUBLIC ::  concnnh4  = 1.e-7_wp      !:  NH4 half saturation for phyto   
     38   REAL(wp), PUBLIC ::  concdnh4  = 4.e-7_wp      !:  NH4 half saturation for diatoms 
     39   REAL(wp), PUBLIC ::  xksi1     = 2.E-6_wp      !:  half saturation constant for Si uptake  
     40   REAL(wp), PUBLIC ::  xksi2     = 3.33e-6_wp    !:  half saturation constant for Si/C  
     41   REAL(wp), PUBLIC ::  xkdoc     = 417.e-6_wp    !:  2nd half-sat. of DOC remineralization   
     42   REAL(wp), PUBLIC ::  concfebac = 1.E-11_wp     !:  Fe half saturation for bacteria  
     43   REAL(wp), PUBLIC ::  qnfelim   = 7.E-6_wp      !:  optimal Fe quota for nanophyto 
     44   REAL(wp), PUBLIC ::  qdfelim   = 7.E-6_wp      !:  optimal Fe quota for diatoms 
     45   REAL(wp), PUBLIC ::  caco3r    = 0.16_wp       !:  mean rainratio  
     46 
     47   ! Coefficient for iron limitation 
     48   REAL(wp) ::  xcoef1   = 0.0016  / 55.85   
     49   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 
     50   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
    4351   !!* Substitution 
    4452#  include "top_substitute.h90" 
     
    6068      !! ** Method  : - ??? 
    6169      !!--------------------------------------------------------------------- 
     70      ! 
    6271      INTEGER, INTENT(in)  :: kt 
     72      ! 
    6373      INTEGER  ::   ji, jj, jk 
    6474      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    65       REAL(wp) ::   zconctemp, zconctemp2, zconctempn, zconctempn2 
    66       REAL(wp) ::   ztemp, zdenom 
     75      REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2 
     76      REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2 
     77      REAL(wp) ::   zdenom, zratio, zironmin 
     78      REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4    
    6779      !!--------------------------------------------------------------------- 
    68  
    69  
    70       !  Tuning of the iron concentration to a minimum 
    71       !  level that is set to the detection limit 
    72       !  ------------------------------------- 
    73  
     80      ! 
     81      IF( nn_timing == 1 )  CALL timing_start('p4z_lim') 
     82      ! 
    7483      DO jk = 1, jpkm1 
    7584         DO jj = 1, jpj 
    7685            DO ji = 1, jpi 
    77                zno3=trn(ji,jj,jk,jpno3) 
    78                zferlim = MAX( 1.5e-11*(zno3/40E-6)**2, 3e-12 ) 
    79                zferlim = MIN( zferlim, 1.5e-11 ) 
     86                
     87               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     88               !------------------------------------- 
     89               zno3    = trn(ji,jj,jk,jpno3) / 40.e-6 
     90               zferlim = MAX( 2e-11 * zno3 * zno3, 5e-12 ) 
     91               zferlim = MIN( zferlim, 3e-11 ) 
    8092               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 
     93 
     94               ! Computation of a variable Ks for iron on diatoms taking into account 
     95               ! that increasing biomass is made of generally bigger cells 
     96               !------------------------------------------------ 
     97               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
     98               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd 
     99               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy ) 
     100               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn 
     101               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     102               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     103 
     104               concdfe(ji,jj,jk) = MAX( conc3       , ( zconcd2 *      conc3    + conc3m        * zconcd ) * z1_trndia ) 
     105               zconc1d           = MAX( 2.* conc0   , ( zconcd2 * 2. * conc0    + conc1         * zconcd ) * z1_trndia ) 
     106               zconc1dnh4        = MAX( 2.* concnnh4, ( zconcd2 * 2. * concnnh4 + concdnh4      * zconcd ) * z1_trndia ) 
     107 
     108               concnfe(ji,jj,jk) = MAX( conc2       , ( zconcn2 * conc2         + conc2m        * zconcn ) * z1_trnphy ) 
     109               zconc0n           = MAX( conc0       , ( zconcn2 * conc0         + 2. * conc0    * zconcn ) * z1_trnphy ) 
     110               zconc0nnh4        = MAX( concnnh4    , ( zconcn2 * concnnh4      + 2. * concnnh4 * zconcn ) * z1_trnphy ) 
     111 
     112               ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     113               ! ----------------------------------------------- 
     114               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) ) 
     115               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
     116               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
     117               ! 
     118               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     119               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 ) 
     120               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy  
     121               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     122               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
     123               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 
     124               xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     125               ! 
     126               zlim1    = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 
     127               zlim3    = trn(ji,jj,jk,jpfer) / ( concfebac+ trn(ji,jj,jk,jpfer) ) 
     128               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
     129               xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
     130 
     131               !   Michaelis-Menten Limitation term for nutrients Diatoms 
     132               !   ---------------------------------------------- 
     133               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) ) 
     134               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
     135               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
     136               ! 
     137               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     138               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  ) 
     139               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
     140               zratio   = trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn) 
     141               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     142               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
     143               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
     144               xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
     145               xlimsi(ji,jj,jk)  = MIN( zlim1, zlim2, zlim4 ) 
     146           END DO 
     147         END DO 
     148      END DO 
     149 
     150      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
     151      ! -------------------------------------------------------------------- 
     152      DO jk = 1, jpkm1 
     153         DO jj = 1, jpj 
     154            DO ji = 1, jpi 
     155               zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * conc0 )    & 
     156                  &   / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)  + conc0 * trn(ji,jj,jk,jpnh4) )  
     157               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 
     158               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concfebac ) 
     159               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
     160               ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
     161               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )  
     162               zetot2 = 1. / ( 30. + etot(ji,jj,jk) )  
     163 
     164               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
     165                  &                       * ztem1 / ( 0.1 + ztem1 )                     & 
     166                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
     167                  &                       * 2.325 * zetot1 * 30. * zetot2               & 
     168                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     169                  &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
     170               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
     171               xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
    81172            END DO 
    82173         END DO 
    83174      END DO 
    84  
    85       !  Computation of a variable Ks for iron on diatoms taking into account 
    86       !  that increasing biomass is made of generally bigger cells 
    87       !  ------------------------------------------------ 
    88  
    89       DO jk = 1, jpkm1 
    90          DO jj = 1, jpj 
    91             DO ji = 1, jpi 
    92                zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia)-5e-7 ) 
    93                zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
    94                zconctempn  = MAX( 0.e0 , trn(ji,jj,jk,jpphy)-1e-6 ) 
    95                zconctempn2 = trn(ji,jj,jk,jpphy) - zconctempn 
    96                concdfe(ji,jj,jk) = ( zconctemp2 * conc3 + conc3m * zconctemp)   & 
    97                   &              / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    98                concdfe(ji,jj,jk) = MAX( conc3, concdfe(ji,jj,jk) ) 
    99                concnfe(ji,jj,jk) = ( zconctempn2 * conc2 + conc2m * zconctempn)   & 
    100                   &              / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    101                concnfe(ji,jj,jk) = MAX( conc2, concnfe(ji,jj,jk) ) 
    102             END DO 
    103          END DO 
    104       END DO 
    105  
    106      !  Michaelis-Menten Limitation term for nutrients Small flagellates 
    107      !      ----------------------------------------------- 
    108       DO jk = 1, jpkm1 
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111               zdenom = 1. / & 
    112                   & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
    113                xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 * zdenom 
    114                xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0    * zdenom 
    115  
    116                zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    117                zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4          )  
    118                zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) 
    119                xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    120                zlim1 = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 
    121                zlim3 = trn(ji,jj,jk,jpfer) / ( conc2    + trn(ji,jj,jk,jpfer) ) 
    122                zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
    123                xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    124  
    125             END DO 
    126          END DO 
    127       END DO 
    128  
    129       !   Michaelis-Menten Limitation term for nutrients Diatoms 
    130       !   ---------------------------------------------- 
    131       DO jk = 1, jpkm1 
    132          DO jj = 1, jpj 
    133             DO ji = 1, jpi 
    134               zdenom = 1. / & 
    135                   & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    136  
    137                xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 * zdenom 
    138                xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1    * zdenom  
    139  
    140                zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    141                zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concdnh4          ) 
    142                zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi   (ji,jj)    ) 
    143                zlim4 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) 
    144                xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
    145  
    146             END DO 
    147          END DO 
    148       END DO 
    149  
    150  
    151       ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    152       ! -------------------------------------------------------------------- 
    153  
    154       DO jk = 1, jpkm1 
    155          DO jj = 1, jpj 
    156             DO ji = 1, jpi 
    157                ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    158                xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
    159                   &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
    160                   &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 
    161                xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
    162                xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 
    163             END DO 
    164          END DO 
    165       END DO 
     175      ! 
     176      IF( nn_timing == 1 )  CALL timing_stop('p4z_lim') 
    166177      ! 
    167178   END SUBROUTINE p4z_lim 
     
    175186      !! 
    176187      !! ** Method  :   Read the nampislim namelist and check the parameters 
    177       !!      called at the first timestep (nit000) 
     188      !!      called at the first timestep (nittrc000) 
    178189      !! 
    179190      !! ** input   :   Namelist nampislim 
     
    182193 
    183194      NAMELIST/nampislim/ conc0, conc1, conc2, conc2m, conc3, conc3m,   & 
    184          &             concnnh4, concdnh4, xksi1, xksi2, xkdoc, caco3r 
    185  
    186       REWIND( numnat )                     ! read numnat 
    187       READ  ( numnat, nampislim ) 
     195         &                xsizedia, xsizephy, concnnh4, concdnh4,       & 
     196         &                xksi1, xksi2, xkdoc, concfebac, qnfelim, qdfelim, caco3r 
     197 
     198      REWIND( numnatp )                     ! read numnat 
     199      READ  ( numnatp, nampislim ) 
    188200 
    189201      IF(lwp) THEN                         ! control print 
     
    191203         WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 
    192204         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    193          WRITE(numout,*) '    mean rainratio                            caco3r    =', caco3r 
    194          WRITE(numout,*) '    NO3, PO4 half saturation                  conc0      =', conc0 
    195          WRITE(numout,*) '    half saturation constant for Si uptake    xksi1     =', xksi1 
    196          WRITE(numout,*) '    half saturation constant for Si/C         xksi2     =', xksi2 
    197          WRITE(numout,*) '    2nd half-sat. of DOC remineralization     xkdoc    =', xkdoc 
    198          WRITE(numout,*) '    Phosphate half saturation for diatoms     conc1     =', conc1 
    199          WRITE(numout,*) '    Iron half saturation for phyto            conc2     =', conc2 
    200          WRITE(numout,*) '    Max iron half saturation for phyto        conc2m    =', conc2m 
    201          WRITE(numout,*) '    Iron half saturation for diatoms          conc3     =', conc3 
    202          WRITE(numout,*) '    Maxi iron half saturation for diatoms     conc3m    =', conc3m 
    203          WRITE(numout,*) '    NH4 half saturation for phyto             concnnh4  =', concnnh4 
    204          WRITE(numout,*) '    NH4 half saturation for diatoms           concdnh4  =', concdnh4 
     205         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
     206         WRITE(numout,*) '    NO3, PO4 half saturation                 conc0     =  ', conc0 
     207         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1 
     208         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2 
     209         WRITE(numout,*) '    2nd half-sat. of DOC remineralization    xkdoc     = ', xkdoc 
     210         WRITE(numout,*) '    Phosphate half saturation for diatoms    conc1     = ', conc1 
     211         WRITE(numout,*) '    Iron half saturation for phyto           conc2     = ', conc2 
     212         WRITE(numout,*) '    Max iron half saturation for phyto       conc2m    = ', conc2m 
     213         WRITE(numout,*) '    Iron half saturation for diatoms         conc3     = ', conc3 
     214         WRITE(numout,*) '    Maxi iron half saturation for diatoms    conc3m    = ', conc3m 
     215         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia 
     216         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy 
     217         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4 
     218         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4 
     219         WRITE(numout,*) '    Fe half saturation for bacteria          concfebac = ', concfebac 
     220         WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim 
     221         WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim 
    205222      ENDIF 
    206223 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2715 r3294  
    99   !!             1.0  !  2004     (O. Aumont) modifications 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence 
     12   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution 
    1113   !!---------------------------------------------------------------------- 
    1214#if defined key_pisces 
     
    1719   !!   p4z_lys_init   :   Read the namelist parameters 
    1820   !!---------------------------------------------------------------------- 
    19    USE trc 
    20    USE oce_trc         ! 
    21    USE trc 
    22    USE sms_pisces 
    23    USE prtctl_trc 
    24    USE iom 
     21   USE oce_trc         !  shared variables between ocean and passive tracers 
     22   USE trc             !  passive tracers common variables  
     23   USE sms_pisces      !  PISCES Source Minus Sink variables 
     24   USE prtctl_trc      !  print control for debugging 
     25   USE iom             !  I/O manager 
    2526 
    2627   IMPLICIT NONE 
     
    5758      !! ** Method  : - ??? 
    5859      !!--------------------------------------------------------------------- 
    59       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zco3 => wrk_3d_2, zcaldiss => wrk_3d_3  
    6160      ! 
    6261      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6362      INTEGER  ::   ji, jj, jk, jn 
    64       REAL(wp) ::   zbot, zalk, zdic, zph, zremco3, zah2 
    65       REAL(wp) ::   zdispot, zfact, zalka 
     63      REAL(wp) ::   zalk, zdic, zph, zah2 
     64      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6665      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    67 #if defined key_diatrc && defined key_iomput 
    6866      REAL(wp) ::   zrfact2 
    69 #endif 
    7067      CHARACTER (len=25) :: charout 
     68      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss    
    7169      !!--------------------------------------------------------------------- 
    72  
    73       IF(  wrk_in_use(3, 2,3) ) THEN 
    74          CALL ctl_stop('p4z_lys: requested workspace arrays unavailable')  ;  RETURN 
    75       END IF 
    76  
    77       zco3(:,:,:) = 0. 
    78 # if defined key_diatrc && defined key_iomput 
     70      ! 
     71      IF( nn_timing == 1 )  CALL timing_start('p4z_lys') 
     72      ! 
     73      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss ) 
     74      ! 
     75      zco3    (:,:,:) = 0. 
    7976      zcaldiss(:,:,:) = 0. 
    80 # endif 
    8177      !     ------------------------------------------- 
    8278      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
     
    9187!CDIR NOVERRCHK 
    9288               DO ji = 1, jpi 
    93  
    94                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    95                   zbot  = borat(ji,jj,jk) 
    96  
    97                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    98                   zbot  = borat(ji,jj,jk) 
    99                   zfact = rhop (ji,jj,jk) / 1000. + rtrn 
    100  
    101                   ! SET DUMMY VARIABLE FOR [H+] 
    102                   zph   = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 
    103  
    104                   ! SET DUMMY VARIABLE FOR [SUM(CO2)]GIVEN  
     89                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     90                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    10591                  zdic  = trn(ji,jj,jk,jpdic) / zfact 
    10692                  zalka = trn(ji,jj,jk,jptal) / zfact 
    107  
    10893                  ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    109                   zalk  = zalka - (  akw3(ji,jj,jk) / zph - zph   & 
    110                      &             + zbot / (1.+ zph / akb3(ji,jj,jk) )  ) 
    111  
     94                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    11295                  ! CALCULATE [H+] and [CO3--] 
    113                   zah2 = SQRT( (zdic-zalk)*(zdic-zalk)+   & 
    114                      &     4.*(zalk*ak23(ji,jj,jk)/ak13(ji,jj,jk))   & 
    115                      &     *(2*zdic-zalk)) 
    116  
    117                   zah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+zah2) 
    118                   zco3(ji,jj,jk) = zalk/(2.+zah2/ak23(ji,jj,jk))*zfact 
    119  
    120                   hi(ji,jj,jk)  = zah2*zfact 
    121  
     96                  zaldi = zdic - zalk 
     97                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
     98                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
     99                  ! 
     100                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
     101                  hi(ji,jj,jk)   = zah2 * zfact 
    122102               END DO 
    123103            END DO 
     
    137117 
    138118               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    139                zomegaca = ( calcon * zco3(ji,jj,jk) ) / aksp(ji,jj,jk) 
     119               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
     120               zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     121               zfact    = rhop(ji,jj,jk) / 1000._wp 
     122               zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk)  
    140123 
    141124               ! SET DEGREE OF UNDER-/SUPERSATURATION 
    142                zexcess0 = MAX( 0., ( 1.- zomegaca ) ) 
     125               excess(ji,jj,jk) = 1._wp - zomegaca 
     126               zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    143127               zexcess  = zexcess0**nca 
    144128 
     
    146130               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147131               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
     132               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
    148133# if defined key_degrad 
    149               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 
    150 # else 
    151               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
     134               zdispot = zdispot * facvol(ji,jj,jk) 
    152135# endif 
    153  
    154136              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    155137              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    156               zremco3 = zdispot / rmtss 
    157               zco3(ji,jj,jk) = zco3(ji,jj,jk) + zremco3 * rfact 
    158               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zremco3 
    159               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zremco3 
    160               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3 
    161  
    162 # if defined key_diatrc && defined key_iomput 
    163               zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution 
    164 # endif 
     138              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution 
     139              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 
     140              ! 
     141              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
     142              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
     143              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    165144            END DO 
    166145         END DO 
    167146      END DO 
    168  
    169 # if defined key_diatrc 
    170 #  if ! defined key_iomput 
    171       trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
    172       trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
    173       trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
    174 #  else 
    175       zrfact2 = 1.e3 * rfact2r 
    176       CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
    177       CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
    178       CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
    179       CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
    180 #  endif 
    181 # endif 
    182       ! 
    183        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    184          WRITE(charout, FMT="('lys ')") 
    185          CALL prt_ctl_trc_info(charout) 
    186          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    187        ENDIF 
    188  
    189       IF( wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_lys: failed to release workspace arrays') 
     147      ! 
     148      IF( ln_diatrc )  THEN 
     149         ! 
     150         IF( lk_iomput ) THEN 
     151            zrfact2 = 1.e3 * rfact2r 
     152            CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
     153            CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
     154            CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
     155            CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
     156         ELSE 
     157            trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
     158            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
     159            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     160         ENDIF 
     161         ! 
     162      ENDIF 
     163      ! 
     164      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     165        WRITE(charout, FMT="('lys ')") 
     166        CALL prt_ctl_trc_info(charout) 
     167        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     168      ENDIF 
     169      ! 
     170      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss ) 
     171      ! 
     172      IF( nn_timing == 1 )  CALL timing_stop('p4z_lys') 
    190173      ! 
    191174   END SUBROUTINE p4z_lys 
     
    199182      !! 
    200183      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    201       !!      called at the first timestep (nit000) 
     184      !!      called at the first timestep (nittrc000) 
    202185      !! 
    203186      !! ** input   :   Namelist nampiscal 
     
    207190      NAMELIST/nampiscal/ kdca, nca 
    208191 
    209       REWIND( numnat )                     ! read numnat 
    210       READ  ( numnat, nampiscal ) 
     192      REWIND( numnatp )                     ! read numnatp 
     193      READ  ( numnatp, nampiscal ) 
    211194 
    212195      IF(lwp) THEN                         ! control print 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r2528 r3294  
    66   !! History :   1.0  !  2002     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   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 
     22   USE p4zprod         !  production 
     23   USE prtctl_trc      !  print control for debugging 
     24   USE iom             !  I/O manager 
    2425 
    2526   IMPLICIT NONE 
     
    3031 
    3132   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xprefc   = 1.0_wp     ,  &  !:  
    34       xprefp   = 0.2_wp     ,  &  !: 
    35       xprefz   = 1.0_wp     ,  &  !: 
    36       xprefpoc = 0.0_wp     ,  &  !: 
    37       resrat2  = 0.005_wp   ,  &  !: 
    38       mzrat2   = 0.03_wp    ,  &  !: 
    39       grazrat2 = 0.7_wp     ,  &  !: 
    40       xkgraz2  = 20E-6_wp   ,  &  !: 
    41       unass2   = 0.3_wp     ,  &  !: 
    42       sigma2   = 0.6_wp     ,  &  !: 
    43       epsher2  = 0.33_wp    ,  &  !:    
    44       grazflux = 5.E3_wp  
    45  
     33   REAL(wp), PUBLIC ::  part2       = 0.5_wp     !: part of calcite not dissolved in mesozoo guts 
     34   REAL(wp), PUBLIC ::  xprefc      = 1.0_wp     !: mesozoo preference for POC  
     35   REAL(wp), PUBLIC ::  xprefp      = 0.3_wp     !: mesozoo preference for nanophyto 
     36   REAL(wp), PUBLIC ::  xprefz      = 1.0_wp     !: mesozoo preference for diatoms 
     37   REAL(wp), PUBLIC ::  xprefpoc    = 0.3_wp     !: mesozoo preference for POC  
     38   REAL(wp), PUBLIC ::  xthresh2zoo = 1E-8_wp    !: zoo feeding threshold for mesozooplankton  
     39   REAL(wp), PUBLIC ::  xthresh2dia = 1E-8_wp    !: diatoms feeding threshold for mesozooplankton  
     40   REAL(wp), PUBLIC ::  xthresh2phy = 2E-7_wp    !: nanophyto feeding threshold for mesozooplankton  
     41   REAL(wp), PUBLIC ::  xthresh2poc = 1E-8_wp    !: poc feeding threshold for mesozooplankton  
     42   REAL(wp), PUBLIC ::  xthresh2    = 0._wp      !: feeding threshold for mesozooplankton  
     43   REAL(wp), PUBLIC ::  resrat2     = 0.005_wp   !: exsudation rate of mesozooplankton 
     44   REAL(wp), PUBLIC ::  mzrat2      = 0.04_wp    !: microzooplankton mortality rate  
     45   REAL(wp), PUBLIC ::  grazrat2    = 0.9_wp     !: maximal mesozoo grazing rate 
     46   REAL(wp), PUBLIC ::  xkgraz2     = 20E-6_wp   !: non assimilated fraction of P by mesozoo  
     47   REAL(wp), PUBLIC ::  unass2      = 0.3_wp     !: Efficicency of mesozoo growth  
     48   REAL(wp), PUBLIC ::  sigma2      = 0.6_wp     !: Fraction of mesozoo excretion as DOM  
     49   REAL(wp), PUBLIC ::  epsher2     = 0.3_wp     !: half sturation constant for grazing 2 
     50   REAL(wp), PUBLIC ::  grazflux    = 3.E3_wp    !: mesozoo flux feeding rate 
    4651 
    4752   !!* Substitution 
     
    6570      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    6671      INTEGER  :: ji, jj, jk 
    67       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
    68       REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 
    69       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
     72      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
     73      REAL(wp) :: zgraze2 , zdenom, zdenom2, zncratio 
     74      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     75      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
     76      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat 
    7077#if defined key_kriest 
    7178      REAL znumpoc 
    7279#endif 
    73       REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
    74       REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
    75       REAL(wp) :: zgrazfff,zgrazffe 
     80      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 
     81      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
     82      REAL(wp) :: zgrazfff, zgrazffe 
    7683      CHARACTER (len=25) :: charout 
    77 #if defined key_diatrc && defined key_iomput 
    7884      REAL(wp) :: zrfact2 
    79 #endif 
    80  
    8185      !!--------------------------------------------------------------------- 
     86      ! 
     87      IF( nn_timing == 1 )  CALL timing_start('p4z_meso') 
     88      ! 
    8289 
    8390      DO jk = 1, jpkm1 
    8491         DO jj = 1, jpj 
    8592            DO ji = 1, jpi 
    86  
    87                zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     93               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 ) 
    8894# if defined key_degrad 
    89                zstep   = xstep * facvol(ji,jj,jk) 
     95               zstep     = xstep * facvol(ji,jj,jk) 
    9096# else 
    91                zstep   = xstep 
     97               zstep     = xstep 
    9298# endif 
    93                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
     99               zfact     = zstep * tgfunc(ji,jj,jk) * zcompam 
    94100 
    95101               !  Respiration rates of both zooplankton 
    96102               !  ------------------------------------- 
    97                zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    98                   &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
     103               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  & 
     104                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 
    99105 
    100106               !  Zooplankton mortality. A square function has been selected with 
    101107               !  no real reason except that it seems to be more stable and may mimic predation 
    102108               !  --------------------------------------------------------------- 
    103                ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     109               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    104110               ! 
    105111 
    106                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    107                zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    108                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    109                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    110  
    111                !  Microzooplankton grazing 
    112                !     ------------------------ 
    113                zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   & 
    114                   &                     + xprefz   * trn(ji,jj,jk,jpzoo)   & 
    115                   &                     + xprefp   * trn(ji,jj,jk,jpphy)   & 
    116                   &                     + xprefpoc * trn(ji,jj,jk,jppoc)  ) 
    117  
    118                zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes)  
    119  
    120                zgrazd   = zgraze2  * xprefc   * zcompadi 
    121                zgrazz   = zgraze2  * xprefz   * zcompaz 
    122                zgrazn   = zgraze2  * xprefp   * zcompaph 
    123                zgrazpoc = zgraze2  * xprefpoc * zcompapoc 
    124  
    125                zgraznf  = zgrazn   * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazf   = zgrazd   * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    127                zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    128                 
     112               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
     113               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
     114               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
     115               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     116 
     117               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc  
     118               zfoodlim  = MAX( 0., zfood - xthresh2 ) 
     119               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     120               zdenom2   = zdenom / ( zfood + rtrn ) 
     121               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)  
     122 
     123               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
     124               zgrazz    = zgraze2  * xprefz   * zcompaz   * zdenom2  
     125               zgrazn    = zgraze2  * xprefp   * zcompaph  * zdenom2  
     126               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2  
     127 
     128               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 
     129               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 
     130               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 
     131 
    129132               !  Mesozooplankton flux feeding on GOC 
    130133               !  ---------------------------------- 
    131134# if ! defined key_kriest 
    132                zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          & 
    133                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    134                zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     135               zgrazffe  = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     136                 &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     137               zgrazfff  = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    135138# else 
    136                !!--------------------------- KRIEST3 ------------------------------------------- 
    137                !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    138                !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    139                !! #  if defined key_degrad 
    140                !!                  &     * facvol(ji,jj,jk)          & 
    141                !! #  endif 
    142                !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    143                !!--------------------------- KRIEST3 ------------------------------------------- 
    144  
    145               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
    146                   &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    147               zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     139               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     140               zgrazfff   = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    148141# endif 
    149        
    150 #if defined key_diatrc 
    151               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    152               grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 
    153 #endif 
    154  
     142              ! 
     143              zgraztot   = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 
     144              zgraztotf  = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff  
     145 
     146              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     147              grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    155148              !    Mesozooplankton efficiency 
    156149              !    -------------------------- 
    157               zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 
    158 #if ! defined key_kriest 
    159               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) &  
    160                   &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    161                   &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    162                   &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    163                   &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     150              zgrasrat   =  zgraztotf / ( zgraztot + rtrn ) 
     151              zncratio   = (  xprefc   * zcompadi * quotad(ji,jj,jk)  & 
     152                  &         + xprefp   * zcompaph * quotan(ji,jj,jk)  & 
     153                  &         + xprefz   * zcompaz                      & 
     154                  &         + xprefpoc * zcompapoc   ) / ( zfood + rtrn ) 
     155               zepshert  = epsher2 * MIN( 1., zncratio ) 
     156               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     157               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 ) 
     158               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert )  
     159               zgrapoc2  = zgraztot * unass2 
     160 
     161               !   Update the arrays TRA which contain the biological sources and sinks 
     162               zgrarsig  = zgrarem2 * sigma2 
     163               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     164               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     165               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     166               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
     167               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     168               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     169               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     170#if defined key_kriest 
     171               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
     172               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     173               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2 
    164174#else 
    165               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 
    166                   &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    167                   &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    168                   &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    169                   &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
    170  
    171 #endif 
    172                !   Update the arrays TRA which contain the biological sources and sinks 
    173  
    174                zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe 
    175  
    176                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
    177                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
    178                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 
    179                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
    180                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    181                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 
    182                 
    183 #if defined key_kriest 
    184                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 
    185                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 
    186 #else 
    187                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 
     175               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
     176               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2 
    188177#endif 
    189178               zmortz2 = ztortz2 + zrespz2 
    190                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     179               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot  
    191180               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    192181               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
     
    199188               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    200189 
    201                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
    202 #if defined key_diatrc 
     190               zprcaca = xfracal(ji,jj,jk) * zgrazn 
     191               ! calcite production 
    203192               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    204 #endif 
    205                zprcaca = part * zprcaca 
     193               ! 
     194               zprcaca = part2 * zprcaca 
    206195               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    207196               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
     
    212201               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
    213202                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    214                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
    215                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 
     203               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof 
    216204#else 
    217205               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
    218206               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
    219207               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 
    220                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
    221                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 
     208               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff 
    222209#endif 
    223210 
     
    226213      END DO 
    227214      ! 
    228 #if defined key_diatrc && defined key_iomput 
    229       zrfact2 = 1.e3 * rfact2r 
    230       ! Total grazing of phyto by zoo 
    231       grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 
    232       ! Calcite production 
    233       prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
    234       IF( jnt == nrdttrc ) then  
    235          CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
    236          CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     215      IF( ln_diatrc .AND. lk_iomput ) THEN 
     216         zrfact2 = 1.e3 * rfact2r 
     217         grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:)   ! Total grazing of phyto by zoo 
     218         prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:)   ! Calcite production 
     219         IF( jnt == nrdttrc ) THEN 
     220            CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
     221            CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     222         ENDIF 
    237223      ENDIF 
    238 #endif 
    239  
    240        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    241          WRITE(charout, FMT="('meso')") 
    242          CALL prt_ctl_trc_info(charout) 
    243          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    244        ENDIF 
    245  
     224      ! 
     225      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     226        WRITE(charout, FMT="('meso')") 
     227        CALL prt_ctl_trc_info(charout) 
     228        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     229      ENDIF 
     230      ! 
     231      IF( nn_timing == 1 )  CALL timing_stop('p4z_meso') 
     232      ! 
    246233   END SUBROUTINE p4z_meso 
    247234 
     
    254241      !! 
    255242      !! ** Method  :   Read the nampismes namelist and check the parameters 
    256       !!      called at the first timestep (nit000) 
     243      !!      called at the first timestep (nittrc000) 
    257244      !! 
    258245      !! ** input   :   Namelist nampismes 
     
    260247      !!---------------------------------------------------------------------- 
    261248 
    262       NAMELIST/nampismes/ grazrat2,resrat2,mzrat2,xprefc, xprefp, & 
    263          &             xprefz, xprefpoc, xkgraz2, epsher2, sigma2, unass2, grazflux 
    264  
    265       REWIND( numnat )                     ! read numnat 
    266       READ  ( numnat, nampismes ) 
     249      NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     250         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
     251         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
     252 
     253      REWIND( numnatp )                     ! read numnatp 
     254      READ  ( numnatp, nampismes ) 
    267255 
    268256 
     
    271259         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
    272260         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    273          WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc 
    274          WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp 
    275          WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz 
    276          WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc 
    277          WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2 
    278          WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2 
    279          WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2 
    280          WRITE(numout,*) '    mesozoo flux feeding rate                 grazflux  =', grazflux 
    281          WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2 
    282          WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2 
    283          WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2 
    284          WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2 
     261         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
     262         WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc 
     263         WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp 
     264         WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz 
     265         WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc 
     266         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
     267         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
     268         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
     269         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
     270         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
     271         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2 
     272         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2 
     273         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
     274         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux 
     275         WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2 
     276         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2 
     277         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
     278         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
    285279      ENDIF 
    286280 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r2528 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_micro_init  :   Initialize and read the appropriate namelist 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   USE sms_pisces      !  PISCES Source Minus Sink variables 
     20   USE p4zlim          !  Co-limitations 
     21   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     22   USE p4zint          !  interpolation and computation of various fields 
     23   USE p4zprod         !  production 
     24   USE prtctl_trc      !  print control for debugging 
    2425 
    2526   IMPLICIT NONE 
     
    2829   PUBLIC   p4z_micro         ! called in p4zbio.F90 
    2930   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
     31   PUBLIC   p4z_micro_alloc    ! called in trcsms_pisces.F90 
    3032 
    3133   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xpref2c = 0.0_wp       ,  &  !: 
    34       xpref2p = 0.5_wp       ,  &  !: 
    35       xpref2d = 0.5_wp       ,  &  !: 
    36       resrat  = 0.03_wp      ,  &  !: 
    37       mzrat   = 0.0_wp       ,  &  !: 
    38       grazrat = 4.0_wp       ,  &  !: 
    39       xkgraz  = 20E-6_wp     ,  &  !: 
    40       unass   = 0.3_wp       ,  &  !: 
    41       sigma1  = 0.6_wp       ,  &  !: 
    42       epsher  = 0.33_wp 
     34   REAL(wp), PUBLIC ::  part       = 0.5_wp     !: part of calcite not dissolved in microzoo guts 
     35   REAL(wp), PUBLIC ::  xpref2c    = 0.2_wp     !: microzoo preference for POC  
     36   REAL(wp), PUBLIC ::  xpref2p    = 1.0_wp     !: microzoo preference for nanophyto 
     37   REAL(wp), PUBLIC ::  xpref2d    = 0.6_wp     !: microzoo preference for diatoms 
     38   REAL(wp), PUBLIC ::  xthreshdia = 1E-8_wp    !: diatoms feeding threshold for microzooplankton  
     39   REAL(wp), PUBLIC ::  xthreshphy = 2E-7_wp    !: nanophyto threshold for microzooplankton  
     40   REAL(wp), PUBLIC ::  xthreshpoc = 1E-8_wp    !: poc threshold for microzooplankton  
     41   REAL(wp), PUBLIC ::  xthresh    = 0._wp      !: feeding threshold for microzooplankton  
     42   REAL(wp), PUBLIC ::  resrat     = 0.03_wp    !: exsudation rate of microzooplankton 
     43   REAL(wp), PUBLIC ::  mzrat      = 0.0_wp     !: microzooplankton mortality rate  
     44   REAL(wp), PUBLIC ::  grazrat    = 3.0_wp     !: maximal microzoo grazing rate 
     45   REAL(wp), PUBLIC ::  xkgraz     = 20E-6_wp   !: non assimilated fraction of P by microzoo  
     46   REAL(wp), PUBLIC ::  unass      = 0.3_wp     !: Efficicency of microzoo growth  
     47   REAL(wp), PUBLIC ::  sigma1     = 0.6_wp     !: Fraction of microzoo excretion as DOM  
     48   REAL(wp), PUBLIC ::  epsher     = 0.3_wp     !: half sturation constant for grazing 1  
    4349 
    4450 
     
    6369      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6470      INTEGER  :: ji, jj, jk 
    65       REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    66       REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep 
    67       REAL(wp) :: zfact   , zinano , zidiat, zipoc 
     71      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 
     72      REAL(wp) :: zgraze  , zdenom, zdenom2, zncratio 
     73      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     74      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
    6875      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    69       REAL(wp) :: zrespz, ztortz 
     76      REAL(wp) :: zrespz, ztortz, zgrasrat 
    7077      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
    7178      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    7279      CHARACTER (len=25) :: charout 
    73  
    7480      !!--------------------------------------------------------------------- 
    75  
    76  
    77 #if defined key_diatrc 
    78       grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    79 #endif 
    80  
    81       zstep = rfact2 / rday      ! Time step duration for biology 
    82  
     81      ! 
     82      IF( nn_timing == 1 )  CALL timing_start('p4z_micro') 
     83      ! 
     84      grazing(:,:,:) = 0.  !: grazing set to zero 
    8385      DO jk = 1, jpkm1 
    8486         DO jj = 1, jpj 
    8587            DO ji = 1, jpi 
    86                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     88               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
     89               zstep   = xstep 
    8790# if defined key_degrad 
    88                zstep   = xstep * facvol(ji,jj,jk) 
    89 # else 
    90                zstep   = xstep 
     91               zstep = zstep * facvol(ji,jj,jk) 
    9192# endif 
    92                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
     93               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
    9394 
    9495               !  Respiration rates of both zooplankton 
    9596               !  ------------------------------------- 
    96                zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    97                   &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
     97               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(ji,jj,jk,jpzoo) )  & 
     98                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    9899 
    99100               !  Zooplankton mortality. A square function has been selected with 
     
    102103               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    103104 
    104                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    105                zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    106                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    107                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
     105               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
     106               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
     107               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    108108                
    109109               !     Microzooplankton grazing 
    110110               !     ------------------------ 
    111                zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 
    112  
    113                zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
    114  
    115                zinano = xpref2p * zcompaph  * zdenom2 
    116                zipoc  = xpref2c * zcompapoc * zdenom2 
    117                zidiat = xpref2d * zcompadi2 * zdenom2 
    118  
    119                zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    120  
    121                zgrazp  = zgraze * zinano * zcompaph * zdenom 
    122                zgrazm  = zgraze * zipoc  * zcompapoc * zdenom 
    123                zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 
    124  
    125                zgrazpf = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazmf = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    127                zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    128 #if defined key_diatrc 
     111               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi 
     112               zfoodlim  = MAX( 0. , zfood - xthresh ) 
     113               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     114               zdenom2   = zdenom / ( zfood + rtrn ) 
     115               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)  
     116 
     117               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
     118               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2  
     119               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2  
     120 
     121               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     122               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     123               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     124               ! 
     125               zgraztot  = zgrazp  + zgrazm  + zgrazsd  
     126               zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     127 
    129128               ! Grazing by microzooplankton 
    130                grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
    131 #endif 
     129               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    132130 
    133131               !    Various remineralization and excretion terms 
    134132               !    -------------------------------------------- 
    135                zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 
    136                zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 
    137                   &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &  
    138                   &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
    139                   &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
    140  
    141                zgrapoc = (  zgrazp + zgrazm + zgrazsd )  
     133               zgrasrat  = zgraztotf / ( zgraztot + rtrn ) 
     134               zncratio  = ( xpref2p * zcompaph * quotan(ji,jj,jk) & 
     135                  &        + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn ) 
     136               zepshert  = epsher * MIN( 1., zncratio ) 
     137               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     138               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert )  
     139               zgrarem   = zgraztot * ( 1. - zepsherv - unass ) 
     140               zgrapoc   = zgraztot * unass 
    142141 
    143142               !  Update of the TRA arrays 
    144143               !  ------------------------ 
    145  
    146                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 
    147                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 
    148                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 
    149                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
     144               zgrarsig  = zgrarem * sigma1 
     145               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     146               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     147               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     148               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    150149               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    151                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 
    152                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
     150               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     151               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
     152               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     153               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    153154#if defined key_kriest 
    154                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     155               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    155156#endif 
    156  
    157                ! 
    158157               !   Update the arrays TRA which contain the biological sources and sinks 
    159158               !   -------------------------------------------------------------------- 
    160  
    161159               zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     160               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztot  
    163161               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164162               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
     
    170168               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171169               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
    172                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 
    173                zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 
    174 #if defined key_diatrc 
     170               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
     171               zprcaca = xfracal(ji,jj,jk) * zgrazp 
     172               ! 
     173               ! calcite production 
    175174               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    176 #endif 
     175               ! 
    177176               zprcaca = part * zprcaca 
    178177               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     
    191190         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    192191      ENDIF 
    193  
     192      ! 
     193      IF( nn_timing == 1 )  CALL timing_stop('p4z_micro') 
     194      ! 
    194195   END SUBROUTINE p4z_micro 
    195196 
     
    203204      !! 
    204205      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    205       !!      called at the first timestep (nit000) 
     206      !!                called at the first timestep (nittrc000) 
    206207      !! 
    207208      !! ** input   :   Namelist nampiszoo 
     
    209210      !!---------------------------------------------------------------------- 
    210211 
    211       NAMELIST/nampiszoo/ grazrat,resrat,mzrat,xpref2c, xpref2p, & 
    212          &             xpref2d, xkgraz, epsher, sigma1, unass 
    213  
    214       REWIND( numnat )                     ! read numnat 
    215       READ  ( numnat, nampiszoo ) 
     212      NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     213         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
     214         &                xthresh, xkgraz, epsher, sigma1, unass 
     215 
     216      REWIND( numnatp )                     ! read numnatp 
     217      READ  ( numnatp, nampiszoo ) 
    216218 
    217219      IF(lwp) THEN                         ! control print 
     
    219221         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
    220222         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    221          WRITE(numout,*) '    zoo preference for POC                    xpref2c    =', xpref2c 
    222          WRITE(numout,*) '    zoo preference for nano                   xpref2p    =', xpref2p 
    223          WRITE(numout,*) '    zoo preference for diatoms                xpref2d    =', xpref2d 
    224          WRITE(numout,*) '    exsudation rate of microzooplankton       resrat    =', resrat 
    225          WRITE(numout,*) '    microzooplankton mortality rate           mzrat     =', mzrat 
    226          WRITE(numout,*) '    maximal microzoo grazing rate             grazrat   =', grazrat 
    227          WRITE(numout,*) '    non assimilated fraction of P by microzoo unass     =', unass 
    228          WRITE(numout,*) '    Efficicency of microzoo growth            epsher    =', epsher 
    229          WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1 
    230          WRITE(numout,*) '    half sturation constant for grazing 1     xkgraz    =', xkgraz 
     223         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
     224         WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c 
     225         WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p 
     226         WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d 
     227         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
     228         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
     229         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
     230         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh 
     231         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat 
     232         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat 
     233         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat 
     234         WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass 
     235         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher 
     236         WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
     237         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz 
    231238      ENDIF 
    232239 
    233240   END SUBROUTINE p4z_micro_init 
     241 
     242   INTEGER FUNCTION p4z_micro_alloc() 
     243      !!---------------------------------------------------------------------- 
     244      !!                     ***  ROUTINE p4z_micro_alloc  *** 
     245      !!---------------------------------------------------------------------- 
     246      ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc ) 
     247      IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.') 
     248 
     249   END FUNCTION p4z_micro_alloc 
    234250 
    235251#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r2528 r3294  
    1414   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
    1515   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE p4zsink 
    21    USE prtctl_trc 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE prtctl_trc      !  print control for debugging 
    2221 
    2322   IMPLICIT NONE 
     
    2726   PUBLIC   p4z_mort_init     
    2827 
    29  
    3028   !! * Shared module variables 
    31    REAL(wp), PUBLIC ::   & 
    32      wchl   = 0.001_wp    ,  &  !: 
    33      wchld  = 0.02_wp     ,  &  !: 
    34      mprat  = 0.01_wp     ,  &  !: 
    35      mprat2 = 0.01_wp     ,  &  !: 
    36      mpratm = 0.01_wp           !: 
     29   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !: 
     30   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !: 
     31   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !: 
     32   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !: 
     33   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !: 
    3734 
    3835 
     
    8077      CHARACTER (len=25) :: charout 
    8178      !!--------------------------------------------------------------------- 
    82  
    83  
    84 #if defined key_diatrc 
    85      prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    86 #endif 
    87  
     79      ! 
     80      IF( nn_timing == 1 )  CALL timing_start('p4z_nano') 
     81      ! 
     82      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    8883      DO jk = 1, jpkm1 
    8984         DO jj = 1, jpj 
    9085            DO ji = 1, jpi 
    91  
    9286               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    93  
     87               zstep    = xstep 
    9488# if defined key_degrad 
    95                zstep =  xstep * facvol(ji,jj,jk)   
    96 # else 
    97                zstep =  xstep   
     89               zstep    = zstep * facvol(ji,jj,jk) 
    9890# endif 
    9991               !     Squared mortality of Phyto similar to a sedimentation term during 
     
    117109               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    118110               zprcaca = xfracal(ji,jj,jk) * zmortp 
    119 #if defined key_diatrc 
     111               ! 
    120112               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    121 #endif 
     113               ! 
    122114               zfracal = 0.5 * xfracal(ji,jj,jk) 
    123115               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     
    143135         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    144136       ENDIF 
    145  
     137      ! 
     138      IF( nn_timing == 1 )  CALL timing_stop('p4z_nano') 
     139      ! 
    146140   END SUBROUTINE p4z_nano 
    147141 
     
    158152      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
    159153      CHARACTER (len=25) :: charout 
    160   
    161       !!--------------------------------------------------------------------- 
    162  
     154      !!--------------------------------------------------------------------- 
     155      ! 
     156      IF( nn_timing == 1 )  CALL timing_start('p4z_diat') 
     157      ! 
    163158 
    164159      !    Aggregation term for diatoms is increased in case of nutrient 
     
    177172               !    sticky and coagulate to sink quickly out of the euphotic zone 
    178173               !     ------------------------------------------------------------ 
    179  
     174               zstep   = xstep 
    180175# if defined key_degrad 
    181                zstep =  xstep * facvol(ji,jj,jk)   
    182 # else 
    183                zstep =  xstep   
     176               zstep = zstep * facvol(ji,jj,jk) 
    184177# endif 
    185178               !  Phytoplankton respiration  
     
    219212      END DO 
    220213      ! 
    221         IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     214      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    222215         WRITE(charout, FMT="('diat')") 
    223216         CALL prt_ctl_trc_info(charout) 
    224217         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    225        ENDIF 
    226               
     218      ENDIF 
     219      ! 
     220      IF( nn_timing == 1 )  CALL timing_stop('p4z_diat') 
     221      ! 
    227222   END SUBROUTINE p4z_diat 
    228223 
     
    243238      NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm 
    244239 
    245       REWIND( numnat )                     ! read numnat 
    246       READ  ( numnat, nampismort ) 
     240      REWIND( numnatp )                     ! read numnatp 
     241      READ  ( numnatp, nampismort ) 
    247242 
    248243      IF(lwp) THEN                         ! control print 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2715 r3294  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
     9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    910   !!---------------------------------------------------------------------- 
    1011#if defined  key_pisces 
     
    1718   USE oce_trc        ! tracer-ocean share variables 
    1819   USE sms_pisces     ! Source Minus Sink of PISCES 
    19    USE iom 
     20   USE iom            ! I/O manager 
    2021 
    2122   IMPLICIT NONE 
     
    5253      !! ** Method  : - ??? 
    5354      !!--------------------------------------------------------------------- 
    54       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
    56       USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
    57       USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
    58       USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
    5955      ! 
    6056      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     
    6359      INTEGER  ::   irgb 
    6460      REAL(wp) ::   zchl, zxsi0r 
    65       REAL(wp) ::   zc0 , zc1 , zc2, zc3 
     61      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
     62      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2 
     63      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3 
    6664      !!--------------------------------------------------------------------- 
    67  
    68       IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
    69          CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
    70       ENDIF 
     65      ! 
     66      IF( nn_timing == 1 )  CALL timing_start('p4z_opt') 
     67      ! 
     68      ! Allocate temporary workspace 
     69      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2       ) 
     70      CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
    7171 
    7272      !     Initialisation of variables used to compute PAR 
     
    8383            DO ji = 1, jpi 
    8484               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    85                zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     85               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    8686               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    8787               !                                                          
     
    9292         END DO 
    9393      END DO 
    94  
    95 !!gm  Potential BUG  must discuss with Olivier about this implementation.... 
    96 !!gm           the questions are : - PAR at T-point or mean PAR over T-level.... 
    97 !!gm                               - shallow water: no penetration of light through the bottom.... 
    9894 
    9995 
     
    145141         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
    146142         ! 
    147          DO jk = 2, nksrp+1 
     143         DO jk = 2, nksrp + 1 
    148144!CDIR NOVERRCHK 
    149145            DO jj = 1, jpj 
     
    188184      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189185      zetmp  (:,:)   = 0.e0 
    190       emoy   (:,:,:) = 0.e0 
     186      zetmp1 (:,:)   = 0.e0 
     187      zetmp2 (:,:)   = 0.e0 
    191188 
    192189      DO jk = 1, nksrp 
     
    196193            DO ji = 1, jpi 
    197194               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    198                   zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 
     195                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
     196                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
     197                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
    199198                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    200199               ENDIF 
     
    210209!CDIR NOVERRCHK 
    211210            DO ji = 1, jpi 
    212                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    213             END DO 
    214          END DO 
    215       END DO 
    216  
    217 #if defined key_diatrc 
    218 # if ! defined key_iomput 
    219       ! save for outputs 
    220       trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
    221       trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    222 # else 
    223       ! write diagnostics  
    224       IF( jnt == nrdttrc ) then  
    225          CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    226          CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     211               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     212                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     213                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
     214                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     215                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     216               ENDIF 
     217            END DO 
     218         END DO 
     219      END DO 
     220 
     221      IF( ln_diatrc ) THEN        ! save output diagnostics 
     222        ! 
     223        IF( lk_iomput ) THEN 
     224           IF( jnt == nrdttrc ) THEN 
     225              CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     226              CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     227           ENDIF 
     228        ELSE 
     229           trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     230           trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
     231        ENDIF 
     232        ! 
    227233      ENDIF 
    228 # endif 
    229 #endif 
    230       ! 
    231       IF(  wrk_not_released(2, 1,2)           .OR.   & 
    232            wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     234      ! 
     235      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
     236      CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
     237      ! 
     238      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
    233239      ! 
    234240   END SUBROUTINE p4z_opt 
     
    241247      !! ** Purpose :   Initialization of tabulated attenuation coef 
    242248      !!---------------------------------------------------------------------- 
     249      ! 
     250      IF( nn_timing == 1 )  CALL timing_start('p4z_opt_init') 
    243251      ! 
    244252      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
     
    252260      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp 
    253261      !  
     262      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init') 
     263      ! 
    254264   END SUBROUTINE p4z_opt_init 
    255265 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2730 r3294  
    22   !!====================================================================== 
    33   !!                         ***  MODULE p4zprod  *** 
    4    !! TOP :   PISCES  
     4   !! TOP :  Growth Rate of the two phytoplanktons groups  
    55   !!====================================================================== 
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1112   !!   'key_pisces'                                       PISCES bio-model 
    1213   !!---------------------------------------------------------------------- 
    13    !!   p4z_prod       :   
     14   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups 
     15   !!   p4z_prod_init  :   Initialization of the parameters for growth 
     16   !!   p4z_prod_alloc :   Allocate variables for growth 
    1417   !!---------------------------------------------------------------------- 
    15    USE trc 
    16    USE oce_trc         ! 
    17    USE sms_pisces      !  
    18    USE prtctl_trc 
    19    USE p4zopt 
    20    USE p4zint 
    21    USE p4zlim 
    22    USE iom 
     18   USE oce_trc         !  shared variables between ocean and passive tracers 
     19   USE trc             !  passive tracers common variables  
     20   USE sms_pisces      !  PISCES Source Minus Sink variables 
     21   USE p4zopt          !  optical model 
     22   USE p4zlim          !  Co-limitations of differents nutrients 
     23   USE prtctl_trc      !  print control for debugging 
     24   USE iom             !  I/O manager 
    2325 
    2426   IMPLICIT NONE 
     
    2931   PUBLIC   p4z_prod_alloc 
    3032 
    31    REAL(wp), PUBLIC ::   & 
    32      pislope   = 3.0_wp          ,  &  !: 
    33      pislope2  = 3.0_wp          ,  &  !: 
    34      excret    = 10.e-5_wp       , &   !: 
    35      excret2   = 0.05_wp         , &   !: 
    36      chlcnm    = 0.033_wp        , &   !: 
    37      chlcdm    = 0.05_wp         , &   !: 
    38      fecnm     = 10.E-6_wp       , &   !: 
    39      fecdm     = 15.E-6_wp       , &   !: 
    40      grosip    = 0.151_wp 
    41  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !: 
     33   !! * Shared module variables 
     34   LOGICAL , PUBLIC ::  ln_newprod = .FALSE. 
     35   REAL(wp), PUBLIC ::  pislope    = 3.0_wp            !: 
     36   REAL(wp), PUBLIC ::  pislope2   = 3.0_wp            !: 
     37   REAL(wp), PUBLIC ::  excret     = 10.e-5_wp         !: 
     38   REAL(wp), PUBLIC ::  excret2    = 0.05_wp           !: 
     39   REAL(wp), PUBLIC ::  bresp      = 0.00333_wp        !: 
     40   REAL(wp), PUBLIC ::  chlcnm     = 0.033_wp          !: 
     41   REAL(wp), PUBLIC ::  chlcdm     = 0.05_wp           !: 
     42   REAL(wp), PUBLIC ::  chlcmin    = 0.00333_wp        !: 
     43   REAL(wp), PUBLIC ::  fecnm      = 10.E-6_wp         !: 
     44   REAL(wp), PUBLIC ::  fecdm      = 15.E-6_wp         !: 
     45   REAL(wp), PUBLIC ::  grosip     = 0.151_wp          !: 
     46 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature) 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee 
    4350    
    44    REAL(wp) ::   & 
    45       rday1                      ,  &  !: 0.6 / rday 
    46       texcret                    ,  &  !: 1 - excret  
    47       texcret2                   ,  &  !: 1 - excret2         
    48       tpp                              !: Total primary production 
     51   REAL(wp) :: r1_rday                !: 1 / rday 
     52   REAL(wp) :: texcret                !: 1 - excret  
     53   REAL(wp) :: texcret2               !: 1 - excret2         
     54   REAL(wp) :: tpp                    !: Total primary production 
     55 
    4956 
    5057   !!* Substitution 
     
    6673      !! ** Method  : - ??? 
    6774      !!--------------------------------------------------------------------- 
    68       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    69       USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1  , zmixdiat    => wrk_2d_2  , zstrn  => wrk_2d_3 
    70       USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2  , zpislopead2 => wrk_3d_3 
    71       USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4  , zprbio      => wrk_3d_5  , zysopt => wrk_3d_6 
    72       USE wrk_nemo, ONLY:   zprorca    => wrk_3d_7  , zprorcad    => wrk_3d_8 
    73       USE wrk_nemo, ONLY:   zprofed    => wrk_3d_9  , zprofen     => wrk_3d_10 
    74       USE wrk_nemo, ONLY:   zprochln   => wrk_3d_11 , zprochld    => wrk_3d_12 
    75       USE wrk_nemo, ONLY:   zpronew    => wrk_3d_13 , zpronewd    => wrk_3d_14 
    7675      ! 
    7776      INTEGER, INTENT(in) :: kt, jnt 
    7877      ! 
    7978      INTEGER  ::   ji, jj, jk 
    80       REAL(wp) ::   zsilfac, zfact 
    81       REAL(wp) ::   zprdiachl, zprbiochl, zsilim, ztn, zadap, zadap2 
    82       REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zetot2, zmax, zproreg, zproreg2 
    83       REAL(wp) ::   zmxltst, zmxlday, zlim1 
     79      REAL(wp) ::   zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2 
     80      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap 
     81      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 
     82      REAL(wp) ::   zmxltst, zmxlday, zmaxday 
    8483      REAL(wp) ::   zpislopen  , zpislope2n 
    85       REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
    86 #if defined key_diatrc 
     84      REAL(wp) ::   zrum, zcodel, zargu, zval 
    8785      REAL(wp) ::   zrfact2 
    88 #endif 
    8986      CHARACTER (len=25) :: charout 
     87      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt    
     89      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 
    9090      !!--------------------------------------------------------------------- 
    91  
    92       IF( wrk_in_use(2, 1,2,3)                             .OR.  & 
    93           wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)  ) THEN 
    94           CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN 
    95       ENDIF 
    96  
     91      ! 
     92      IF( nn_timing == 1 )  CALL timing_start('p4z_prod') 
     93      ! 
     94      !  Allocate temporary workspace 
     95      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
     96      CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
     97      CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     98      ! 
    9799      zprorca (:,:,:) = 0._wp 
    98100      zprorcad(:,:,:) = 0._wp 
     
    105107      zprdia  (:,:,:) = 0._wp 
    106108      zprbio  (:,:,:) = 0._wp 
     109      zprdch  (:,:,:) = 0._wp 
     110      zprnch  (:,:,:) = 0._wp 
    107111      zysopt  (:,:,:) = 0._wp 
    108112 
    109113      ! Computation of the optimal production 
    110 # if defined key_degrad 
    111       prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    112 # else 
    113       prmax(:,:,:) = rday1 * tgfunc(:,:,:) 
    114 # endif 
     114      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)  
     115      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)  
    115116 
    116117      ! compute the day length depending on latitude and the day 
     
    119120 
    120121      ! day length in hours 
    121       zstrn(:,:) = 0._wp 
     122      zstrn(:,:) = 0. 
    122123      DO jj = 1, jpj 
    123124         DO ji = 1, jpi 
    124125            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    125126            zargu = MAX( -1., MIN(  1., zargu ) ) 
    126             zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    127             IF( zval < 1.e0 )   zval = 24. 
    128             zstrn(ji,jj) = 24. / zval 
     127            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    129128         END DO 
    130129      END DO 
    131130 
    132  
     131      IF( ln_newprod ) THEN 
     132         ! Impact of the day duration on phytoplankton growth 
     133         DO jk = 1, jpkm1 
     134            DO jj = 1 ,jpj 
     135               DO ji = 1, jpi 
     136                  zval = MAX( 1., zstrn(ji,jj) ) 
     137                  zval = 1.5 * zval / ( 12. + zval ) 
     138                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     139                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     140               END DO 
     141            END DO 
     142         END DO 
     143      ENDIF 
     144 
     145      ! Maximum light intensity 
     146      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     147      zstrn(:,:) = 24. / zstrn(:,:) 
     148 
     149      IF( ln_newprod ) THEN 
     150!CDIR NOVERRCHK 
     151         DO jk = 1, jpkm1 
     152!CDIR NOVERRCHK 
     153            DO jj = 1, jpj 
     154!CDIR NOVERRCHK 
     155               DO ji = 1, jpi 
     156 
     157                  ! Computation of the P-I slope for nanos and diatoms 
     158                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     159                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     160                      zadap  = ztn / ( 2.+ ztn ) 
     161 
     162                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 
     163                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     164 
     165                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     166                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     167 
     168                      zfact  = EXP( -0.21 * znanotot ) 
     169                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  & 
     170                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
     171 
     172                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
     173                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
     174 
     175                      ! Computation of production function for Carbon 
     176                      !  --------------------------------------------- 
     177                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcnm ) * rday + rtrn) 
     178                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcdm ) * rday + rtrn) 
     179                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
     180                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
     181 
     182                      !  Computation of production function for Chlorophyll 
     183                      !-------------------------------------------------- 
     184                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
     185                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
     186                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     187                  ENDIF 
     188               END DO 
     189            END DO 
     190         END DO 
     191      ELSE 
     192!CDIR NOVERRCHK 
     193         DO jk = 1, jpkm1 
     194!CDIR NOVERRCHK 
     195            DO jj = 1, jpj 
     196!CDIR NOVERRCHK 
     197               DO ji = 1, jpi 
     198 
     199                  ! Computation of the P-I slope for nanos and diatoms 
     200                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     201                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     202                      zadap  = ztn / ( 2.+ ztn ) 
     203 
     204                      zfact  = EXP( -0.21 * enano(ji,jj,jk) ) 
     205                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
     206                      zpislopead2(ji,jj,jk) = pislope2 
     207 
     208                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                & 
     209                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
     210                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     211 
     212                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
     213                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
     214                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     215 
     216                      ! Computation of production function for Carbon 
     217                      !  --------------------------------------------- 
     218                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
     219                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     220 
     221                      !  Computation of production function for Chlorophyll 
     222                      !-------------------------------------------------- 
     223                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 
     224                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 
     225                  ENDIF 
     226               END DO 
     227            END DO 
     228         END DO 
     229      ENDIF 
     230 
     231      !  Computation of a proxy of the N/C ratio 
     232      !  --------------------------------------- 
    133233!CDIR NOVERRCHK 
    134234      DO jk = 1, jpkm1 
     
    137237!CDIR NOVERRCHK 
    138238            DO ji = 1, jpi 
    139  
    140                ! Computation of the P-I slope for nanos and diatoms 
    141                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    142                    ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    143                    zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
    144                    zadap2 = 0.e0 
    145  
    146                    zfact  = EXP( -0.21 * emoy(ji,jj,jk) ) 
    147  
    148                    zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
    149                    zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 
    150  
    151                    zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                 & 
    152                      &         / ( trn(ji,jj,jk,jpphy) * 12.                   + rtrn )   & 
    153                      &         / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    154  
    155                    zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
    156                      &          / ( trn(ji,jj,jk,jpdia) * 12.                   + rtrn )   & 
    157                      &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    158  
    159                    ! Computation of production function 
    160                    zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 
    161                      &                (  1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    162                    zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 
    163                      &                (  1.- EXP( -zpislope2n * ediat(ji,jj,jk) )  ) 
    164                ENDIF 
     239                zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     240                quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
     241                zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     242                quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
    165243            END DO 
    166244         END DO 
     
    178256                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    179257                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    180  
    181                   zlim1  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
    182                   zlim   = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    183  
    184                   zsilim = MIN( zprdia(ji,jj,jk)    / ( rtrn + prmax(ji,jj,jk) ),                 & 
    185                   &          trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ),   & 
    186                   &          trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ),            & 
    187                   &          zlim ) 
    188                   zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) )  ) + 1.e0 
     258                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
     259                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     260                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    189261                  zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 
    190                   zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 ) 
    191                   zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
    192                   zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 
     262                  zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 
     263                  zsilfac = MIN( 5.4, zsilfac * zsilfac2) 
     264                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac 
    193265              ENDIF 
    194266            END DO 
     
    196268      END DO 
    197269 
    198       !  Computation of the limitation term due to 
    199       !  A mixed layer deeper than the euphotic depth 
     270      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    200271      DO jj = 1, jpj 
    201272         DO ji = 1, jpi 
    202273            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 
    203             zmxlday = zmxltst**2 / rday 
    204             zmixnano(ji,jj) = 1.- zmxlday / ( 1.+ zmxlday ) 
    205             zmixdiat(ji,jj) = 1.- zmxlday / ( 3.+ zmxlday ) 
     274            zmxlday = zmxltst * zmxltst * r1_rday 
     275            zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday ) 
     276            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 
    206277         END DO 
    207278      END DO 
     
    219290      END DO 
    220291 
    221  
    222 !CDIR NOVERRCHK 
    223       DO jk = 1, jpkm1 
    224 !CDIR NOVERRCHK 
    225          DO jj = 1, jpj 
    226 !CDIR NOVERRCHK 
    227             DO ji = 1, jpi 
    228  
    229                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    230                   !     Computation of the various production terms for nanophyto. 
    231                   zetot2 = enano(ji,jj,jk) * zstrn(ji,jj) 
    232                   zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 
    233                   zpislopen = zpislopead(ji,jj,jk)          & 
    234                   &         * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.)         & 
    235                   &         / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 
    236  
    237                   zprbiochl = prmax(ji,jj,jk) * (  1.- EXP( -zpislopen * zetot2 )  ) 
    238  
    239                   zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
    240  
    241                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk)    & 
    242                   &             / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    243                   zprod = rday * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 
    244  
    245                   zprofen(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm            & 
    246                   &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn  ) 
    247  
    248                   zprochln(ji,jj,jk) = chlcnm * 144. * zprod                  & 
    249                   &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn  ) 
    250                ENDIF 
    251             END DO 
    252          END DO 
    253       END DO 
    254  
     292      ! Computation of the various production terms  
    255293!CDIR NOVERRCHK 
    256294      DO jk = 1, jpkm1 
     
    260298            DO ji = 1, jpi 
    261299               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    262                   !  Computation of the various production terms for diatoms 
    263                   zetot2 = ediat(ji,jj,jk) * zstrn(ji,jj) 
    264                   zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 
    265                   zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)        & 
    266                   &           / ( rtrn + trn(ji,jj,jk,jpdia) * 12.)        & 
    267                   &           / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 
    268  
    269                   zprdiachl = prmax(ji,jj,jk) * (  1.- EXP( -zetot2 * zpislope2n )  ) 
    270  
     300                  !  production terms for nanophyto. 
     301                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
     302                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     303                  ! 
     304                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     305                  zratio = zratio / fecnm  
     306                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     307                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  & 
     308                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     309                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) )  & 
     310                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2 
     311                  !  production terms for diatomees 
    271312                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 
    272  
    273                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk)     & 
    274                   &              / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    275  
    276                   zprod = rday * zprorcad(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 
    277  
    278                   zprofed(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm                   & 
    279                   &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 
    280  
    281                   zprochld(ji,jj,jk) = chlcdm * 144. * zprod       & 
    282                   &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 
    283  
     313                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     314                  ! 
     315                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     316                  zratio = zratio / fecdm  
     317                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     318                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  & 
     319                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     320                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) )  & 
     321                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2 
    284322               ENDIF 
    285323            END DO 
    286324         END DO 
    287325      END DO 
    288       ! 
     326 
     327      IF( ln_newprod ) THEN 
     328!CDIR NOVERRCHK 
     329         DO jk = 1, jpkm1 
     330!CDIR NOVERRCHK 
     331            DO jj = 1, jpj 
     332!CDIR NOVERRCHK 
     333               DO ji = 1, jpi 
     334                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     335                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
     336                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
     337                  ENDIF 
     338                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     339                     !  production terms for nanophyto. ( chlorophyll ) 
     340                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     341                     zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     342                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
     343                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / (  zpislopead(ji,jj,jk) * znanotot +rtrn) 
     344                     !  production terms for diatomees ( chlorophyll ) 
     345                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     346                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     347                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
     348                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 
     349                  ENDIF 
     350               END DO 
     351            END DO 
     352         END DO 
     353      ELSE 
     354!CDIR NOVERRCHK 
     355         DO jk = 1, jpkm1 
     356!CDIR NOVERRCHK 
     357            DO jj = 1, jpj 
     358!CDIR NOVERRCHK 
     359               DO ji = 1, jpi 
     360                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     361                     !  production terms for nanophyto. ( chlorophyll ) 
     362                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     363                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 
     364                     zprochln(ji,jj,jk) = chlcnm * 144. * zprod / (  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn) 
     365                     !  production terms for diatomees ( chlorophyll ) 
     366                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     367                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 
     368                     zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 
     369                  ENDIF 
     370               END DO 
     371            END DO 
     372         END DO 
     373      ENDIF 
    289374 
    290375      !   Update the arrays TRA which contain the biological sources and sinks 
     
    304389              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 
    305390              tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 
    306               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 
    307               &                     excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
     391              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
    308392              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
    309               &                    + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    310               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 
    311               &                     - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
    312               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 
    313               &                     - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     393                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     394              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
     395              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    314396              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    315               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) & 
    316               &                    + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     397              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     398                 &                                      - rno3 * ( zproreg + zproreg2 ) 
    317399          END DO 
    318400        END DO 
     
    320402 
    321403     ! Total primary production per year 
    322  
    323 #if defined key_degrad 
    324      tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
    325 #else 
    326404     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    327 #endif 
    328  
    329      IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 
     405 
     406     IF( kt == nitend .AND. jnt == nrdttrc ) THEN 
    330407        WRITE(numout,*) 'Total PP (Gtc) :' 
    331408        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
     
    333410      ENDIF 
    334411 
    335 #if defined key_diatrc && ! defined key_iomput 
    336       !   Supplementary diagnostics 
    337       zrfact2 = 1.e3 * rfact2r 
    338       trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
    339       trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
    340       trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
    341       trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
    342       trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
    343       trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
     412     IF( ln_diatrc ) THEN 
     413         ! 
     414         zrfact2 = 1.e3 * rfact2r 
     415         IF( lk_iomput ) THEN 
     416           IF( jnt == nrdttrc ) THEN 
     417              CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
     418              CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
     419              CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
     420              CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
     421              CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
     422              CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
     423              CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
     424           ENDIF 
     425         ELSE 
     426              trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     427              trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     428              trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     429              trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     430              trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     431              trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    344432#  if ! defined key_kriest 
    345       trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     433              trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    346434#  endif 
    347 #endif 
    348  
    349 #if defined key_diatrc && defined key_iomput 
    350       zrfact2 = 1.e3 * rfact2r 
    351       IF ( jnt == nrdttrc ) then 
    352          CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
    353          CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
    354          CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
    355          CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
    356          CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
    357          CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
    358          CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
    359       ENDIF 
    360 #endif 
     435         ENDIF 
     436         ! 
     437      ENDIF 
    361438 
    362439      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    365442         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    366443      ENDIF 
    367  
    368       IF(  wrk_not_released(2, 1,2,3)                          .OR.  & 
    369            wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)   )   & 
    370            CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     444      ! 
     445      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
     446      CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
     447      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     448      ! 
     449      IF( nn_timing == 1 )  CALL timing_stop('p4z_prod') 
    371450      ! 
    372451   END SUBROUTINE p4z_prod 
     
    380459      !! 
    381460      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    382       !!      called at the first timestep (nit000) 
     461      !!      called at the first timestep (nittrc000) 
    383462      !! 
    384463      !! ** input   :   Namelist nampisprod 
    385464      !!---------------------------------------------------------------------- 
    386       NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    387          &              fecnm, fecdm, grosip 
     465      ! 
     466      NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  & 
     467         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    388468      !!---------------------------------------------------------------------- 
    389469 
    390       REWIND( numnat )                     ! read numnat 
    391       READ  ( numnat, nampisprod ) 
     470      REWIND( numnatp )                     ! read numnatp 
     471      READ  ( numnatp, nampisprod ) 
    392472 
    393473      IF(lwp) THEN                         ! control print 
     
    395475         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 
    396476         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    397          WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip 
    398          WRITE(numout,*) '    P-I slope                                 pislope   =', pislope 
    399          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret    =', excret 
    400          WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2 
    401          WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2 
    402          WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm 
    403          WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm 
    404          WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm 
    405          WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
    406       ENDIF 
    407       ! 
    408       rday1     = 0.6 / rday  
    409       texcret   = 1.0 - excret 
    410       texcret2  = 1.0 - excret2 
    411       tpp       = 0. 
     477         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod 
     478         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
     479         WRITE(numout,*) '    P-I slope                                 pislope      =', pislope 
     480         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret 
     481         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2 
     482         IF( ln_newprod )  THEN 
     483            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
     484            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
     485         ENDIF 
     486         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2 
     487         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
     488         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
     489         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm 
     490         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm 
     491      ENDIF 
     492      ! 
     493      r1_rday   = 1._wp / rday  
     494      texcret   = 1._wp - excret 
     495      texcret2  = 1._wp - excret2 
     496      tpp       = 0._wp 
    412497      ! 
    413498   END SUBROUTINE p4z_prod_init 
     
    418503      !!                     ***  ROUTINE p4z_prod_alloc  *** 
    419504      !!---------------------------------------------------------------------- 
    420       ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
     505      ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc ) 
    421506      ! 
    422507      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2773 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1213   !!   'key_pisces'                                       PISCES bio-model 
    1314   !!---------------------------------------------------------------------- 
    14    !!   p4z_rem       :   Compute remineralization/scavenging of organic compounds 
    15    !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE sms_pisces      !  
    19    USE prtctl_trc 
    20    USE p4zint 
    21    USE p4zopt 
    22    USE p4zmeso 
    23    USE p4zprod 
    24    USE p4zche 
     15   !!   p4z_rem       :  Compute remineralization/scavenging of organic compounds 
     16   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation 
     17   !!   p4z_rem_alloc :  Allocate remineralisation variables 
     18   !!---------------------------------------------------------------------- 
     19   USE oce_trc         !  shared variables between ocean and passive tracers 
     20   USE trc             !  passive tracers common variables  
     21   USE sms_pisces      !  PISCES Source Minus Sink variables 
     22   USE p4zopt          !  optical model 
     23   USE p4zche          !  chemical model 
     24   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 
     27   USE prtctl_trc      !  print control for debugging 
    2528 
    2629   IMPLICIT NONE 
     
    3134   PUBLIC   p4z_rem_alloc 
    3235 
    33    REAL(wp), PUBLIC ::   & 
    34      xremik  = 0.3_wp      ,  & !: 
    35      xremip  = 0.025_wp    ,  & !: 
    36      nitrif  = 0.05_wp     ,  & !: 
    37      xsirem  = 0.015_wp    ,  & !: 
    38      xlam1   = 0.005_wp    ,  & !: 
    39      oxymin  = 1.e-6_wp         !: 
    40  
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
     36   !! * Shared module variables 
     37   REAL(wp), PUBLIC ::  xremik    = 0.3_wp     !: remineralisation rate of POC  
     38   REAL(wp), PUBLIC ::  xremip    = 0.025_wp   !: remineralisation rate of DOC 
     39   REAL(wp), PUBLIC ::  nitrif    = 0.05_wp    !: NH4 nitrification rate  
     40   REAL(wp), PUBLIC ::  xsirem    = 0.003_wp   !: remineralisation rate of POC  
     41   REAL(wp), PUBLIC ::  xsiremlab = 0.025_wp   !: fast remineralisation rate of POC  
     42   REAL(wp), PUBLIC ::  xsilab    = 0.31_wp    !: fraction of labile biogenic silica  
     43   REAL(wp), PUBLIC ::  xlam1     = 0.005_wp   !: scavenging rate of Iron  
     44   REAL(wp), PUBLIC ::  oxymin    = 1.e-6_wp   !: halk saturation constant for anoxia  
     45   REAL(wp), PUBLIC ::  ligand    = 0.6E-9_wp  !: ligand concentration in the ocean  
     46 
     47 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    4250 
    4351 
     
    5967      !! ** Method  : - ??? 
    6068      !!--------------------------------------------------------------------- 
    61       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    62       USE wrk_nemo, ONLY:   ztempbac => wrk_2d_1 
    63       USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2 , zolimi => wrk_3d_3 
    6469      ! 
    6570      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6671      ! 
    6772      INTEGER  ::   ji, jj, jk 
    68       REAL(wp) ::   zremip, zremik , zlam1b 
     73      REAL(wp) ::   zremip, zremik , zlam1b, zdepbac2 
    6974      REAL(wp) ::   zkeq  , zfeequi, zsiremin, zfesatur 
    70       REAL(wp) ::   zsatur, zsatur2, znusil 
     75      REAL(wp) ::   zsatur, zsatur2, znusil, zdep, zfactdep 
    7176      REAL(wp) ::   zbactfer, zorem, zorem2, zofer 
    72       REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe 
     77      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe, zcoag 
    7378#if ! defined key_kriest 
    7479      REAL(wp) ::   zofer2, zdenom, zdenom2 
     
    7681      REAL(wp) ::   zlamfac, zonitr, zstep 
    7782      CHARACTER (len=25) :: charout 
     83      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac  
     84      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zolimi2 
    7885      !!--------------------------------------------------------------------- 
    79  
    80       IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3)  ) THEN 
    81          CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')   ;   RETURN 
    82       ENDIF 
     86      ! 
     87      IF( nn_timing == 1 )  CALL timing_start('p4z_rem') 
     88      ! 
     89      ! Allocate temporary workspace 
     90      CALL wrk_alloc( jpi, jpj,      ztempbac                 ) 
     91      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 
    8392 
    8493       ! Initialisation of temprary arrys 
    8594       zdepbac (:,:,:) = 0._wp 
    8695       zolimi  (:,:,:) = 0._wp 
     96       zolimi2 (:,:,:) = 0._wp 
    8797       ztempbac(:,:)   = 0._wp 
    8898 
     
    93103         DO jj = 1, jpj 
    94104            DO ji = 1, jpi 
    95                IF( fsdept(ji,jj,jk) < 120. ) THEN 
     105               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     106               IF( fsdept(ji,jj,jk) < zdep ) THEN 
    96107                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 ) 
    97108                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    98109               ELSE 
    99                   zdepbac(ji,jj,jk) = MIN( 1., 120./ fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
     110                  zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
    100111               ENDIF 
    101112            END DO 
     
    117128         DO jj = 1, jpj 
    118129            DO ji = 1, jpi 
     130               zstep   = xstep 
    119131# if defined key_degrad 
    120                zstep = xstep * facvol(ji,jj,jk) 
    121 # else 
    122                zstep = xstep 
     132               zstep = zstep * facvol(ji,jj,jk) 
    123133# endif 
    124134               ! DOC ammonification. Depends on depth, phytoplankton biomass 
     
    126136               !     of the bacterial activity.  
    127137               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    128                zremik = MAX( zremik, 5.5e-4 * xstep ) 
    129  
     138               zremik = MAX( zremik, 2.e-4 * xstep ) 
    130139               !     Ammonification in oxic waters with oxygen consumption 
    131140               !     ----------------------------------------------------- 
    132                zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    133                   &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    134  
     141               zolimi (ji,jj,jk) = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  
     142               zolimi2(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimi(ji,jj,jk) )  
    135143               !     Ammonification in suboxic waters with denitrification 
    136144               !     ------------------------------------------------------- 
    137                denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
     145               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    138146                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    139             END DO 
    140          END DO 
    141       END DO 
    142  
    143       DO jk = 1, jpkm1 
    144          DO jj = 1, jpj 
    145             DO ji = 1, jpi 
     147               ! 
    146148               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     149               zolimi2(ji,jj,jk) = MAX( 0.e0, zolimi2(ji,jj,jk) ) 
    147150               denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
    148             END DO 
    149          END DO 
    150       END DO 
    151  
    152       DO jk = 1, jpkm1 
    153          DO jj = 1, jpj 
    154             DO ji = 1, jpi 
     151               ! 
     152            END DO 
     153         END DO 
     154      END DO 
     155 
     156 
     157      DO jk = 1, jpkm1 
     158         DO jj = 1, jpj 
     159            DO ji = 1, jpi 
     160               zstep   = xstep 
    155161# if defined key_degrad 
    156                zstep = xstep * facvol(ji,jj,jk) 
    157 # else 
    158                zstep = xstep 
     162               zstep = zstep * facvol(ji,jj,jk) 
    159163# endif 
    160164               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    161165               !    below 2 umol/L. Inhibited at strong light  
    162166               !    ---------------------------------------------------------- 
    163                zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
    164  
     167               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     168               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
    165169               !   Update of the tracers trends 
    166170               !   ---------------------------- 
    167  
    168                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
    169                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     171               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk) 
     172               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk) 
    170173               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    171                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    172  
     174               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk) 
    173175            END DO 
    174176         END DO 
     
    189191               !    studies (especially at Papa) have shown this uptake to be significant 
    190192               !    ---------------------------------------------------------- 
    191                zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    192                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    193                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    194                   &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    195                   &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
     193               zdepbac2 = zdepbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
     194               zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk)                                 & 
     195                  &              * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) )    & 
     196                  &              * zdepbac2 / ( xkgraz2 + zdepbac(ji,jj,jk) )               & 
     197                  &              * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    196198 
    197199               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer 
     
    214216         DO jj = 1, jpj 
    215217            DO ji = 1, jpi 
     218               zstep   = xstep 
    216219# if defined key_degrad 
    217                zstep = xstep * facvol(ji,jj,jk) 
    218 # else 
    219                zstep = xstep 
     220               zstep = zstep * facvol(ji,jj,jk) 
    220221# endif 
    221222               !    POC disaggregation by turbulence and bacterial activity.  
    222223               !    ------------------------------------------------------------- 
    223                zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     224               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.7 * nitrfac(ji,jj,jk) )  
    224225 
    225226               !    POC disaggregation rate is reduced in anoxic zone as shown by 
     
    266267         DO jj = 1, jpj 
    267268            DO ji = 1, jpi 
     269               zstep   = xstep 
    268270# if defined key_degrad 
    269                zstep = xstep * facvol(ji,jj,jk) 
    270 # else 
    271                zstep = xstep 
     271               zstep = zstep * facvol(ji,jj,jk) 
    272272# endif 
    273273               !     Remineralization rate of BSi depedant on T and saturation 
    274274               !     --------------------------------------------------------- 
    275                zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    276                zsatur  = MAX( rtrn, zsatur ) 
    277                zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
    278                znusil  = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 
    279                zsiremin = xsirem * zstep * znusil 
    280                zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
    281  
     275               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
     276               zsatur   = MAX( rtrn, zsatur ) 
     277               zsatur2  = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
     278               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9.25 
     279               zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
     280               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep ) 
     281               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 ) 
     282               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 
     283               zosil    = zsiremin * trn(ji,jj,jk,jpdsi) 
     284               ! 
    282285               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    283286               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
     
    293296       ENDIF 
    294297 
    295       zfesatur = 0.6e-9 
     298      zfesatur = ligand 
    296299!CDIR NOVERRCHK 
    297300      DO jk = 1, jpkm1 
     
    300303!CDIR NOVERRCHK 
    301304            DO ji = 1, jpi 
     305               zstep   = xstep 
    302306# if defined key_degrad 
    303                zstep = xstep * facvol(ji,jj,jk) 
    304 # else 
    305                zstep = xstep 
     307               zstep = zstep * facvol(ji,jj,jk) 
    306308# endif 
    307309               !  Compute de different ratios for scavenging of iron 
     
    312314           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    313315#else 
    314                zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    315            &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    316  
     316               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    317317               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    318318               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     
    337337               !  Increased scavenging for very high iron concentrations 
    338338               !  found near the coasts due to increased lithogenic particles 
    339                !  and let s say it unknown processes (precipitation, ...) 
     339               !  and let say it is unknown processes (precipitation, ...) 
    340340               !  ----------------------------------------------------------- 
     341               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1. ) ) 
     342               zcoag   = zfeequi * zlam1b * zstep 
    341343               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    342344               zlamfac = MIN( 1.  , zlamfac ) 
     345               zdep    =  MIN(1., 1000. / fsdept(ji,jj,jk) ) 
    343346#if ! defined key_kriest 
    344347               zlam1b = (  80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 )                           & 
    345                   &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )                    & 
    346                   &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)                & 
    347                   &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    348 #else 
    349                zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)           & 
     348                  &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )    & 
     349                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     350#else 
     351               zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)              & 
    350352                  &     + 698.*  trn(ji,jj,jk,jppoc)  )                    & 
    351                   &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)           & 
    352                   &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    353 #endif 
    354  
     353                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     354#endif 
    355355               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    356  
    357                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    358  
     356               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag 
    359357#if defined key_kriest 
    360358               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 
     
    378376 
    379377      DO jk = 1, jpkm1 
    380          tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi(:,:,jk) + denitr(:,:,jk) 
    381          tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi(:,:,jk) + denitr(:,:,jk) 
    382          tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr(:,:,jk) * rdenit 
    383          tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi(:,:,jk) - denitr(:,:,jk) 
    384          tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi(:,:,jk) * o2ut 
    385          tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
    386          tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
     378         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     379         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     380         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit 
     381         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk) 
     382         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi2(:,:,jk) * o2ut 
     383         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk) 
     384         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) ) 
    387385      END DO 
    388386 
     
    393391      ENDIF 
    394392      ! 
    395       IF(  wrk_not_released(2, 1)     .OR.   & 
    396            wrk_not_released(3, 2,3)  )   CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
     393      CALL wrk_dealloc( jpi, jpj,      ztempbac                 ) 
     394      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 
     395      ! 
     396      IF( nn_timing == 1 )  CALL timing_stop('p4z_rem') 
    397397      ! 
    398398   END SUBROUTINE p4z_rem 
     
    411411      !! 
    412412      !!---------------------------------------------------------------------- 
    413       NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
    414       !!---------------------------------------------------------------------- 
    415  
    416       REWIND( numnat )                     ! read numnat 
    417       READ  ( numnat, nampisrem ) 
     413      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab,   & 
     414      &                   xlam1, oxymin, ligand  
     415 
     416      REWIND( numnatp )                     ! read numnatp 
     417      READ  ( numnatp, nampisrem ) 
    418418 
    419419      IF(lwp) THEN                         ! control print 
     
    424424         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
    425425         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
     426         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab 
     427         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab 
    426428         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
    427429         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
    428430         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
     431         WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand 
    429432      ENDIF 
    430433      ! 
    431       nitrfac(:,:,:) = 0._wp 
    432       denitr (:,:,:) = 0._wp 
     434      nitrfac (:,:,:) = 0._wp 
     435      denitr  (:,:,:) = 0._wp 
     436      denitnh4(:,:,:) = 0._wp 
    433437      ! 
    434438   END SUBROUTINE p4z_rem_init 
     
    439443      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    440444      !!---------------------------------------------------------------------- 
    441       ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
     445      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    442446      ! 
    443447      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r2774 r3294  
    66   !! History :   1.0  !  2004-03 (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) USE of fldread 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1516   !!   p4z_sed_init   :  Initialization of p4z_sed 
    1617   !!---------------------------------------------------------------------- 
    17    USE trc 
    18    USE oce_trc         ! 
    19    USE sms_pisces 
    20    USE prtctl_trc 
    21    USE p4zbio 
    22    USE p4zint 
    23    USE p4zopt 
    24    USE p4zsink 
    25    USE p4zrem 
    26    USE p4zlim 
    27    USE iom 
    28  
     18   USE oce_trc         !  shared variables between ocean and passive tracers 
     19   USE trc             !  passive tracers common variables  
     20   USE sms_pisces      !  PISCES Source Minus Sink variables 
     21   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     22   USE p4zopt          !  optical model 
     23   USE p4zlim          !  Co-limitations of differents nutrients 
     24   USE p4zrem          !  Remineralisation of organic matter 
     25   USE p4zint          !  interpolation and computation of various fields 
     26   USE iom             !  I/O manager 
     27   USE fldread         !  time interpolation 
     28   USE prtctl_trc      !  print control for debugging 
    2929 
    3030   IMPLICIT NONE 
     
    3636 
    3737   !! * Shared module variables 
    38    LOGICAL, PUBLIC :: ln_dustfer  = .FALSE.    !: boolean for dust input from the atmosphere 
    39    LOGICAL, PUBLIC :: ln_river    = .FALSE.    !: boolean for river input of nutrients 
    40    LOGICAL, PUBLIC :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N 
    41    LOGICAL, PUBLIC :: ln_sedinput = .FALSE.    !: boolean for Fe input from sediments 
    42  
    43    REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp   !: Coastal release of Iron 
    44    REAL(wp), PUBLIC :: dustsolub  = 0.014_wp   !: Solubility of the dust 
     38   LOGICAL  :: ln_dust     = .FALSE.    !: boolean for dust input from the atmosphere 
     39   LOGICAL  :: ln_river    = .FALSE.    !: boolean for river input of nutrients 
     40   LOGICAL  :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N 
     41   LOGICAL  :: ln_ironsed  = .FALSE.    !: boolean for Fe input from sediments 
     42 
     43   REAL(wp) :: sedfeinput  = 1.E-9_wp   !: Coastal release of Iron 
     44   REAL(wp) :: dustsolub   = 0.014_wp   !: Solubility of the dust 
     45   REAL(wp) :: wdust       = 2.0_wp     !: Sinking speed of the dust  
     46   REAL(wp) :: nitrfix     = 1E-7_wp    !: Nitrogen fixation rate    
     47   REAL(wp) :: diazolight  = 50._wp     !: Nitrogen fixation sensitivty to light  
     48   REAL(wp) :: concfediaz  = 1.E-10_wp  !: Fe half-saturation Cste for diazotrophs  
     49 
    4550 
    4651   !! * Module variables 
    4752   REAL(wp) :: ryyss                  !: number of seconds per year  
    48    REAL(wp) :: ryyss1                 !: inverse of ryyss 
     53   REAL(wp) :: r1_ryyss                 !: inverse of ryyss 
    4954   REAL(wp) :: rmtss                  !: number of seconds per month 
    50    REAL(wp) :: rday1                  !: inverse of rday 
    51  
    52    INTEGER , PARAMETER :: jpmth = 12  !: number of months per year 
    53    INTEGER , PARAMETER :: jpyr  = 1   !: one year 
    54  
    55    INTEGER ::  numdust                !: logical unit for surface fluxes data 
    56    INTEGER ::  nflx1 , nflx2          !: first and second record used 
    57    INTEGER ::  nflx11, nflx12 
    58  
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo    !: set of dust fields 
     55   REAL(wp) :: r1_rday                  !: inverse of rday 
     56   LOGICAL  :: ll_sbc 
     57 
     58   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust 
     59   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdic  ! structure of input riverdic 
     60   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdoc  ! structure of input riverdoc 
     61   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition 
     62   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment 
     63 
     64   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file 
     65   INTEGER  :: ntimes_dust, ntimes_riv, ntimes_ndep       ! number of time steps in a file 
     66 
    6067   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust      !: dust fields 
    6168   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivinp, cotdep    !: river input fields 
     
    8693      !! ** Method  : - ??? 
    8794      !!--------------------------------------------------------------------- 
    88       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    89       USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3 
    90       USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3 
    9195      ! 
    9296      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     
    96100      REAL(wp) ::   zrivalk, zrivsil, zrivpo4 
    97101#endif 
    98       REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
    99       REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
     102      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact, zfactcal 
     103      REAL(wp) ::   zsiloss, zcaloss, zwsbio3, zwsbio4, zwscal, zdep 
    100104      CHARACTER (len=25) :: charout 
     105      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3 
     106      REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep 
    101107      !!--------------------------------------------------------------------- 
    102  
    103       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 
    104          CALL ctl_stop('p4z_sed: requested workspace arrays unavailable')  ;  RETURN 
    105       END IF 
    106  
    107       IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
     108      ! 
     109      IF( nn_timing == 1 )  CALL timing_start('p4z_sed') 
     110      ! 
     111      ! Allocate temporary workspace 
     112      CALL wrk_alloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 ) 
     113      CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zirondep             ) 
     114 
     115      IF( jnt == 1 .AND. ll_sbc ) CALL p4z_sbc( kt ) 
     116 
     117      zirondep(:,:,:) = 0.e0          ! Initialisation of variables USEd to compute deposition 
     118      zsidep  (:,:)   = 0.e0 
    108119 
    109120      ! Iron and Si deposition at the surface 
    110121      ! ------------------------------------- 
    111  
    112122      DO jj = 1, jpj 
    113123         DO ji = 1, jpi 
    114             zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   & 
    115                &             * rfact2 / fse3t(ji,jj,1) 
    116             zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) 
     124            zdep  = rfact2 / fse3t(ji,jj,1) 
     125            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss ) * zdep 
     126            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * zdep / ( 28.1 * rmtss ) 
    117127         END DO 
    118128      END DO 
     
    120130      ! Iron solubilization of particles in the water column 
    121131      ! ---------------------------------------------------- 
    122  
    123132      DO jk = 2, jpkm1 
    124          zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4 
     133         zirondep(:,:,jk) = dust(:,:) / ( wdust * 55.85 * rmtss ) * rfact2 * 1.e-4 * EXP( -fsdept(:,:,jk) / 1000. ) 
    125134      END DO 
    126135 
    127136      ! Add the external input of nutrients, carbon and alkalinity 
    128137      ! ---------------------------------------------------------- 
    129  
    130138      trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2  
    131139      trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2 
     
    139147      ! (dust, river and sediment mobilization) 
    140148      ! ------------------------------------------------------ 
    141  
    142149      DO jk = 1, jpkm1 
    143150         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 
    144151      END DO 
    145  
    146152 
    147153#if ! defined key_sed 
     
    154160            ikt = mbkt(ji,jj)  
    155161# if defined key_kriest 
    156             zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
    157             zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
     162            zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
     163            zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
    158164# else 
    159             zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
    160             zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
     165            zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
     166            zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
    161167# endif 
    162          END DO 
    163       END DO 
    164       zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 
    165       zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 
    166       DO jj = 1, jpj 
    167          DO ji = 1, jpi 
    168             ikt = mbkt(ji,jj)  
    169             zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 
    170          END DO 
    171       END DO 
    172       zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 
     168            ! For calcite, burial efficiency is made a function of saturation 
     169            zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
     170            zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     171            zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 * zfactcal 
     172         END DO 
     173      END DO 
     174      zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
     175      zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
     176      zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 
    173177#endif 
    174178 
    175       ! Then this loss is scaled at each bottom grid cell for 
     179      ! THEN this loss is scaled at each bottom grid cell for 
    176180      ! equilibrating the total budget of silica in the ocean. 
    177181      ! Thus, the amount of silica lost in the sediments equal 
    178182      ! the supply at the surface (dust+rivers) 
    179183      ! ------------------------------------------------------ 
     184#if ! defined key_sed 
     185      zrivsil =  1._wp - ( sumdepsi + rivalkinput * r1_ryyss / 6. ) / zsumsedsi  
     186      zrivpo4 =  1._wp - ( rivpo4input * r1_ryyss ) / zsumsedpo4  
     187#endif 
    180188 
    181189      DO jj = 1, jpj 
    182190         DO ji = 1, jpi 
    183             ikt = mbkt(ji,jj) 
    184             zfact = xstep / fse3t(ji,jj,ikt) 
    185             zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 
    186             zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 
    187             zwscal  = 1._wp - zfact * wscal (ji,jj,ikt) 
     191            ikt  = mbkt(ji,jj) 
     192            zdep = xstep / fse3t(ji,jj,ikt) 
     193            zwsbio4 = wsbio4(ji,jj,ikt) * zdep 
     194            zwscal  = wscal (ji,jj,ikt) * zdep 
     195# if defined key_kriest 
     196            zsiloss = trn(ji,jj,ikt,jpdsi) * zwsbio4 
     197# else 
     198            zsiloss = trn(ji,jj,ikt,jpdsi) * zwscal 
     199# endif 
     200            zcaloss = trn(ji,jj,ikt,jpcal) * zwscal 
    188201            ! 
    189 # if defined key_kriest 
    190             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 
    191             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 
    192             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
    193             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    194 # else 
    195             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal  
    196             trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 
    197             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
    198             trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 
    199             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    200 # endif 
    201             trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 
    202          END DO 
    203       END DO 
    204  
     202            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zsiloss 
     203            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss 
    205204#if ! defined key_sed 
    206       zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi  
    207       zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal  
    208       zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4  
     205            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
     206            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     207            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     208            zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / zsumsedcal  
     209            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
     210            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     211#endif 
     212         END DO 
     213      END DO 
     214 
    209215      DO jj = 1, jpj 
    210216         DO ji = 1, jpi 
    211             ikt = mbkt(ji,jj) 
    212             zfact = xstep / fse3t(ji,jj,ikt) 
    213             zwsbio3 = zfact * wsbio3(ji,jj,ikt) 
    214             zwsbio4 = zfact * wsbio4(ji,jj,ikt) 
    215             zwscal  = zfact * wscal (ji,jj,ikt) 
    216             trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0 
    217             trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk 
    218 # if defined key_kriest 
    219             trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil  
    220             trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4  
     217            ikt  = mbkt(ji,jj) 
     218            zdep = xstep / fse3t(ji,jj,ikt) 
     219            zwsbio4 = wsbio4(ji,jj,ikt) * zdep 
     220            zwsbio3 = wsbio3(ji,jj,ikt) * zdep 
     221# if ! defined key_kriest 
     222            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zwsbio4 
     223            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 
     224            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zwsbio4 
     225            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 
     226#if ! defined key_sed 
     227            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 
     228               &               + ( trn(ji,jj,ikt,jpgoc) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 
     229#endif 
     230 
    221231# else 
    222             trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil  
    223             trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   & 
    224             &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 
     232            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zwsbio4 
     233            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 
     234            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 
     235#if ! defined key_sed 
     236            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 
     237               &               + ( trn(ji,jj,ikt,jpnum) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 
     238#endif 
     239 
    225240# endif 
    226241         END DO 
    227242      END DO 
    228 # endif 
     243 
    229244 
    230245      ! Nitrogen fixation (simple parameterization). The total gain 
     
    233248      ! ------------------------------------------------------------- 
    234249 
    235       zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit 
     250      zdenitot = glob_sum(  ( denitr(:,:,:) * rdenit + denitnh4(:,:,:) * rdenita ) * cvol(:,:,:) )  
    236251 
    237252      ! Potential nitrogen fixation dependant on temperature and iron 
     
    246261               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    247262               IF( zlim <= 0.2 )   zlim = 0.01 
    248                znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   & 
    249 # if defined key_degrad 
    250                &                  * facvol(ji,jj,jk)   & 
    251 # endif 
    252                &                  * zlim * rfact2 * trn(ji,jj,jk,jpfer)   & 
    253                &                  / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) ) 
     263#if defined key_degrad 
     264               zfact = zlim * rfact2 * facvol(ji,jj,jk) 
     265#else 
     266               zfact = zlim * rfact2  
     267#endif 
     268               znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   & 
     269                 &                 *  zfact * trn(ji,jj,jk,jpfer) / ( concfediaz + trn(ji,jj,jk,jpfer) ) & 
     270                 &                 * ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) 
    254271            END DO 
    255272         END DO  
     
    260277      ! Nitrogen change due to nitrogen fixation 
    261278      ! ---------------------------------------- 
    262  
    263279      DO jk = 1, jpk 
    264280         DO jj = 1, jpj 
    265281            DO ji = 1, jpi 
    266                zfact = znitrpot(ji,jj,jk) * 1.e-7 
     282               zfact = znitrpot(ji,jj,jk) * nitrfix 
    267283               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 
     284               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact 
    268285               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit 
    269                trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact 
    270             END DO 
    271          END DO 
    272       END DO 
    273  
    274 #if defined key_diatrc 
    275       zfact = 1.e+3 * rfact2r 
    276 #  if  ! defined key_iomput 
    277       trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    278       trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    279 #  else 
    280       zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
    281       zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    282       IF( jnt == nrdttrc ) THEN 
    283          CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron 
    284          CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface 
    285       ENDIF 
    286 #  endif 
    287 #endif 
    288       ! 
    289        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    290          WRITE(charout, FMT="('sed ')") 
     286               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30. / 46. * zfact 
     287           !    trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + zfact 
     288           END DO 
     289         END DO  
     290      END DO 
     291      ! 
     292      IF( ln_diatrc ) THEN 
     293         zfact = 1.e+3 * rfact2r 
     294         IF( lk_iomput ) THEN 
     295            zwork1(:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
     296            zwork2(:,:)  =    znitrpot(:,:,1) * nitrfix                   * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     297            IF( jnt == nrdttrc ) THEN 
     298               CALL iom_put( "Irondep", zwork1  )  ! surface downward net flux of iron 
     299               CALL iom_put( "Nfix"   , zwork2 )  ! nitrogen fixation at surface 
     300            ENDIF 
     301         ELSE 
     302            trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)           * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     303            trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     304         ENDIF 
     305      ENDIF 
     306      ! 
     307      IF(ln_ctl) THEN  ! print mean trends (USEd for debugging) 
     308         WRITE(charout, fmt="('sed ')") 
    291309         CALL prt_ctl_trc_info(charout) 
    292310         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
    293        ENDIF 
    294  
    295       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) )   & 
    296         &         CALL ctl_stop('p4z_sed: failed to release workspace arrays') 
    297  
     311      ENDIF 
     312      ! 
     313      CALL wrk_dealloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 ) 
     314      CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zirondep             ) 
     315      ! 
     316      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed') 
     317      ! 
    298318   END SUBROUTINE p4z_sed 
    299319 
    300320   SUBROUTINE p4z_sbc( kt ) 
    301  
    302321      !!---------------------------------------------------------------------- 
    303       !!                  ***  ROUTINE p4z_sbc  *** 
    304       !! 
    305       !! ** Purpose :   Read and interpolate the external sources of  
     322      !!                  ***  routine p4z_sbc  *** 
     323      !! 
     324      !! ** purpose :   read and interpolate the external sources of  
    306325      !!                nutrients 
    307326      !! 
    308       !! ** Method  :   Read the files and interpolate the appropriate variables 
     327      !! ** method  :   read the files and interpolate the appropriate variables 
    309328      !! 
    310329      !! ** input   :   external netcdf files 
     
    314333      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    315334 
    316       !! * Local declarations 
    317       INTEGER :: imois, i15, iman  
    318       REAL(wp) :: zxy 
    319  
     335      !! * local declarations 
     336      INTEGER  :: ji,jj  
     337      REAL(wp) :: zcoef 
    320338      !!--------------------------------------------------------------------- 
    321  
    322       ! Initialization 
    323       ! -------------- 
    324  
    325       i15 = nday / 16 
    326       iman  = INT( raamo ) 
    327       imois = nmonth + i15 - 1 
    328       IF( imois == 0 ) imois = iman 
    329  
    330       ! Calendar computation 
    331       IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    332  
    333          IF( kt == nit000 )  nflx1  = 0 
    334  
    335          ! nflx1 number of the first file record used in the simulation 
    336          ! nflx2 number of the last  file record 
    337  
    338          nflx1 = imois 
    339          nflx2 = nflx1 + 1 
    340          nflx1 = MOD( nflx1, iman ) 
    341          nflx2 = MOD( nflx2, iman ) 
    342          IF( nflx1 == 0 )   nflx1 = iman 
    343          IF( nflx2 == 0 )   nflx2 = iman 
    344          IF(lwp) WRITE(numout,*)  
    345          IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 
    346          IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2 
    347  
    348       ENDIF 
    349  
    350       ! 3. at every time step interpolation of fluxes 
    351       ! --------------------------------------------- 
    352  
    353       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 
    354       dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 
    355  
     339      ! 
     340      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc') 
     341      ! 
     342      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
     343      IF( ln_dust ) THEN 
     344         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
     345            CALL fld_read( kt, 1, sf_dust ) 
     346            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     347         ENDIF 
     348      ENDIF 
     349 
     350      ! N/P and Si releases due to coastal rivers 
     351      ! Compute river at nit000 or only if there is more than 1 time record in river file 
     352      ! ----------------------------------------- 
     353      IF( ln_river ) THEN 
     354         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
     355            CALL fld_read( kt, 1, sf_riverdic ) 
     356            CALL fld_read( kt, 1, sf_riverdoc ) 
     357            DO jj = 1, jpj 
     358               DO ji = 1, jpi 
     359                  zcoef = ryyss * cvol(ji,jj,1)  
     360                  cotdep(ji,jj) =   sf_riverdic(1)%fnow(ji,jj,1)                                  * 1E9 / ( 12. * zcoef + rtrn ) 
     361                  rivinp(ji,jj) = ( sf_riverdic(1)%fnow(ji,jj,1) + sf_riverdoc(1)%fnow(ji,jj,1) ) * 1E9 / ( 31.6* zcoef + rtrn ) 
     362               END DO 
     363            END DO 
     364         ENDIF 
     365      ENDIF 
     366 
     367      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 
     368      IF( ln_ndepo ) THEN 
     369         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
     370            CALL fld_read( kt, 1, sf_ndepo ) 
     371            DO jj = 1, jpj 
     372               DO ji = 1, jpi 
     373                  nitdep(ji,jj) = 7.6 * sf_ndepo(1)%fnow(ji,jj,1) / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 
     374               END DO 
     375            END DO 
     376         ENDIF 
     377      ENDIF 
     378      ! 
     379      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc') 
     380      ! 
    356381   END SUBROUTINE p4z_sbc 
    357382 
    358  
    359383   SUBROUTINE p4z_sed_init 
    360384 
    361385      !!---------------------------------------------------------------------- 
    362       !!                  ***  ROUTINE p4z_sed_init  *** 
    363       !! 
    364       !! ** Purpose :   Initialization of the external sources of nutrients 
    365       !! 
    366       !! ** Method  :   Read the files and compute the budget 
    367       !!      called at the first timestep (nit000) 
     386      !!                  ***  routine p4z_sed_init  *** 
     387      !! 
     388      !! ** purpose :   initialization of the external sources of nutrients 
     389      !! 
     390      !! ** method  :   read the files and compute the budget 
     391      !!                called at the first timestep (nittrc000) 
    368392      !! 
    369393      !! ** input   :   external netcdf files 
    370394      !! 
    371395      !!---------------------------------------------------------------------- 
    372       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    373       USE wrk_nemo, ONLY: zriverdoc => wrk_2d_1, zriver => wrk_2d_2, zndepo => wrk_2d_3 
    374       USE wrk_nemo, ONLY: zcmask => wrk_3d_2 
    375       ! 
    376       INTEGER :: ji, jj, jk, jm 
    377       INTEGER :: numriv, numbath, numdep 
    378       REAL(wp) ::   zcoef 
    379       REAL(wp) ::   expide, denitide,zmaskt 
    380       ! 
    381       NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 
     396      ! 
     397      INTEGER  :: ji, jj, jk, jm 
     398      INTEGER  :: numdust, numriv, numiron, numdepo 
     399      INTEGER  :: ierr, ierr1, ierr2, ierr3 
     400      REAL(wp) :: zexpide, zdenitide, zmaskt 
     401      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
     402      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriverdic, zriverdoc, zcmask 
     403      ! 
     404      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     405      TYPE(FLD_N) ::   sn_dust, sn_riverdoc, sn_riverdic, sn_ndepo, sn_ironsed        ! informations about the fields to be read 
     406      NAMELIST/nampissed/cn_dir, sn_dust, sn_riverdic, sn_riverdoc, sn_ndepo, sn_ironsed, & 
     407        &                ln_dust, ln_river, ln_ndepo, ln_ironsed,         & 
     408        &                sedfeinput, dustsolub, wdust, nitrfix, diazolight, concfediaz  
    382409      !!---------------------------------------------------------------------- 
    383  
    384       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2) ) ) THEN 
    385          CALL ctl_stop('p4z_sed_init: requested workspace arrays unavailable')  ;  RETURN 
    386       END IF 
    387       ! 
    388       REWIND( numnat )                     ! read numnat 
    389       READ  ( numnat, nampissed ) 
     410      ! 
     411      IF( nn_timing == 1 )  CALL timing_start('p4z_sed_init') 
     412      ! 
     413      !                                    ! number of seconds per year and per month 
     414      ryyss    = nyear_len(1) * rday 
     415      rmtss    = ryyss / raamo 
     416      r1_rday  = 1. / rday 
     417      r1_ryyss = 1. / ryyss 
     418      !                            !* set file information 
     419      cn_dir  = './'            ! directory in which the model is executed 
     420      ! ... default values (NB: frequency positive => hours, negative => months) 
     421      !                  !   file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     422      !                  !   name       !  (hours)  !   name      !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     423      sn_dust     = FLD_N( 'dust'       ,    -1     ,  'dust'     ,  .true.    , .true.  ,   'yearly'  , ''       , ''         ) 
     424      sn_riverdic = FLD_N( 'river'      ,   -12     ,  'riverdic' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     425      sn_riverdoc = FLD_N( 'river'      ,   -12     ,  'riverdoc' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     426      sn_ndepo    = FLD_N( 'ndeposition',   -12     ,  'ndep'     ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     427      sn_ironsed  = FLD_N( 'ironsed'    ,   -12     ,  'bathy'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     428 
     429      REWIND( numnatp )                     ! read numnatp 
     430      READ  ( numnatp, nampissed ) 
    390431 
    391432      IF(lwp) THEN 
    392433         WRITE(numout,*) ' ' 
    393          WRITE(numout,*) ' Namelist : nampissed ' 
     434         WRITE(numout,*) ' namelist : nampissed ' 
    394435         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 
    395          WRITE(numout,*) '    Dust input from the atmosphere           ln_dustfer  = ', ln_dustfer 
    396          WRITE(numout,*) '    River input of nutrients                 ln_river    = ', ln_river 
    397          WRITE(numout,*) '    Atmospheric deposition of N              ln_ndepo    = ', ln_ndepo 
    398          WRITE(numout,*) '    Fe input from sediments                  ln_sedinput = ', ln_sedinput 
    399          WRITE(numout,*) '    Coastal release of Iron                  sedfeinput  =', sedfeinput 
    400          WRITE(numout,*) '    Solubility of the dust                   dustsolub   =', dustsolub 
    401       ENDIF 
    402  
    403       ! Dust input from the atmosphere 
     436         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust 
     437         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river 
     438         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo 
     439         WRITE(numout,*) '    fe input from sediments                  ln_sedinput = ', ln_ironsed 
     440         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput 
     441         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub 
     442         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust 
     443         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix 
     444         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     445         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     446       END IF 
     447 
     448      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN 
     449          ll_sbc = .TRUE. 
     450      ELSE 
     451          ll_sbc = .FALSE. 
     452      ENDIF 
     453 
     454      ! dust input from the atmosphere 
    404455      ! ------------------------------ 
    405       IF( ln_dustfer ) THEN  
    406          IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere ' 
     456      IF( ln_dust ) THEN  
     457         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere ' 
    407458         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    408          CALL iom_open ( 'dust.orca.nc', numdust ) 
    409          DO jm = 1, jpmth 
    410             CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
     459         ! 
     460         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     461         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     462         ! 
     463         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     464                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   ) 
     465         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 
     466         ! 
     467         ! Get total input dust ; need to compute total atmospheric supply of Si in a year 
     468         CALL iom_open (  TRIM( sn_dust%clname ) , numdust ) 
     469         CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file 
     470         ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 
     471         DO jm = 1, ntimes_dust 
     472            CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 
    411473         END DO 
    412474         CALL iom_close( numdust ) 
     475         sumdepsi = 0.e0 
     476         DO jm = 1, ntimes_dust 
     477            sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     478         ENDDO 
     479         sumdepsi = sumdepsi * r1_ryyss * 8.8 * 0.075 / 28.1  
     480         DEALLOCATE( zdust) 
    413481      ELSE 
    414          dustmo(:,:,:) = 0.e0 
    415          dust(:,:) = 0.0 
    416       ENDIF 
    417  
    418       ! Nutrient input from rivers 
     482         dust(:,:) = 0._wp 
     483         sumdepsi  = 0._wp 
     484      END IF 
     485 
     486      ! nutrient input from rivers 
    419487      ! -------------------------- 
    420488      IF( ln_river ) THEN 
    421          IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file' 
    422          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    423          CALL iom_open ( 'river.orca.nc', numriv ) 
    424          CALL iom_get  ( numriv, jpdom_data, 'riverdic', zriver   (:,:), jpyr ) 
    425          CALL iom_get  ( numriv, jpdom_data, 'riverdoc', zriverdoc(:,:), jpyr ) 
     489         ALLOCATE( sf_riverdic(1), STAT=ierr1 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     490         ALLOCATE( sf_riverdoc(1), STAT=ierr2 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     491         IF( ierr1 + ierr2 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     492         ! 
     493         CALL fld_fill( sf_riverdic, (/ sn_riverdic /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     494         CALL fld_fill( sf_riverdoc, (/ sn_riverdoc /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     495                                   ALLOCATE( sf_riverdic(1)%fnow(jpi,jpj,1)   ) 
     496                                   ALLOCATE( sf_riverdoc(1)%fnow(jpi,jpj,1)   ) 
     497         IF( sn_riverdic%ln_tint ) ALLOCATE( sf_riverdic(1)%fdta(jpi,jpj,1,2) ) 
     498         IF( sn_riverdoc%ln_tint ) ALLOCATE( sf_riverdoc(1)%fdta(jpi,jpj,1,2) ) 
     499         ! Get total input rivers ; need to compute total river supply in a year 
     500         CALL iom_open ( TRIM( sn_riverdic%clname ), numriv ) 
     501         CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv) 
     502         ALLOCATE( zriverdic(jpi,jpj,ntimes_riv) )   ;     ALLOCATE( zriverdoc(jpi,jpj,ntimes_riv) ) 
     503         DO jm = 1, ntimes_riv 
     504            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdic%clvar ), zriverdic(:,:,jm), jm ) 
     505            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdoc%clvar ), zriverdoc(:,:,jm), jm ) 
     506         END DO 
    426507         CALL iom_close( numriv ) 
     508         ! N/P and Si releases due to coastal rivers 
     509         ! ----------------------------------------- 
     510         rivpo4input = 0._wp  
     511         rivalkinput = 0._wp  
     512         DO jm = 1, ntimes_riv 
     513            rivpo4input = rivpo4input + glob_sum( ( zriverdic(:,:,jm) + zriverdoc(:,:,jm) ) * tmask(:,:,1) )  
     514            rivalkinput = rivalkinput + glob_sum(   zriverdic(:,:,jm)                       * tmask(:,:,1) )  
     515         END DO 
     516         rivpo4input = rivpo4input * 1E9 / 31.6_wp 
     517         rivalkinput = rivalkinput * 1E9 / 12._wp  
     518         DEALLOCATE( zriverdic)   ;    DEALLOCATE( zriverdoc)  
    427519      ELSE 
    428          zriver   (:,:) = 0.e0 
    429          zriverdoc(:,:) = 0.e0 
    430       endif 
    431  
    432       ! Nutrient input from dust 
     520         rivinp(:,:) = 0._wp 
     521         cotdep(:,:) = 0._wp 
     522         rivpo4input = 0._wp 
     523         rivalkinput = 0._wp 
     524      END IF  
     525 
     526      ! nutrient input from dust 
    433527      ! ------------------------ 
    434528      IF( ln_ndepo ) THEN 
    435          IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc' 
     529         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc' 
    436530         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    437          CALL iom_open ( 'ndeposition.orca.nc', numdep ) 
    438          CALL iom_get  ( numdep, jpdom_data, 'ndep', zndepo(:,:), jpyr ) 
    439          CALL iom_close( numdep ) 
     531         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     532         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     533         ! 
     534         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     535                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   ) 
     536         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) 
     537         ! 
     538         ! Get total input dust ; need to compute total atmospheric supply of N in a year 
     539         CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 
     540         CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 
     541         ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 
     542         DO jm = 1, ntimes_ndep 
     543            CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 
     544         END DO 
     545         CALL iom_close( numdepo ) 
     546         nitdepinput = 0._wp 
     547         DO jm = 1, ntimes_ndep 
     548           nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     549         ENDDO 
     550         nitdepinput = nitdepinput * 7.6 / 14E6  
     551         DEALLOCATE( zndepo) 
    440552      ELSE 
    441          zndepo(:,:) = 0.e0 
    442       ENDIF 
    443  
    444       ! Coastal and island masks 
     553         nitdep(:,:) = 0._wp 
     554         nitdepinput = 0._wp 
     555      ENDIF 
     556 
     557      ! coastal and island masks 
    445558      ! ------------------------ 
    446       IF( ln_sedinput ) THEN      
    447          IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron' 
     559      IF( ln_ironsed ) THEN      
     560         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron' 
    448561         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    449          IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file ' 
    450          CALL iom_open ( 'bathy.orca.nc', numbath ) 
    451          CALL iom_get  ( numbath, jpdom_data, 'bathy', zcmask(:,:,:), jpyr ) 
    452          CALL iom_close( numbath ) 
     562         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 
     563         ALLOCATE( zcmask(jpi,jpj,jpk) ) 
     564         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 
     565         CALL iom_close( numiron ) 
    453566         ! 
    454567         DO jk = 1, 5 
     
    459572                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    460573                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) )  
    461                   ENDIF 
     574                  END IF 
    462575               END DO 
    463576            END DO 
    464577         END DO 
     578         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    465579         DO jk = 1, jpk 
    466580            DO jj = 1, jpj 
    467581               DO ji = 1, jpi 
    468                   expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
    469                   denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2 
    470                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 ) 
     582                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
     583                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
     584                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    471585               END DO 
    472586            END DO 
    473587         END DO 
     588         ! Coastal supply of iron 
     589         ! ------------------------- 
     590         ironsed(:,:,jpk) = 0._wp 
     591         DO jk = 1, jpkm1 
     592            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
     593         END DO 
     594         DEALLOCATE( zcmask) 
    474595      ELSE 
    475          zcmask(:,:,:) = 0.e0 
    476       ENDIF 
    477  
    478       CALL lbc_lnk( zcmask , 'T', 1. )      ! Lateral boundary conditions on zcmask   (sign unchanged) 
    479  
    480  
    481       !                                    ! Number of seconds per year and per month 
    482       ryyss  = nyear_len(1) * rday 
    483       rmtss  = ryyss / raamo 
    484       rday1  = 1. / rday 
    485       ryyss1 = 1. / ryyss 
    486       !                                    ! ocean surface cell 
    487  
    488       ! total atmospheric supply of Si 
    489       ! ------------------------------ 
    490       sumdepsi = 0.e0 
    491       DO jm = 1, jpmth 
    492          zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1         
    493          sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 
    494       ENDDO 
    495  
    496       ! N/P and Si releases due to coastal rivers 
    497       ! ----------------------------------------- 
    498       DO jj = 1, jpj 
    499          DO ji = 1, jpi 
    500             zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1)  
    501             cotdep(ji,jj) =  zriver(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) 
    502             rivinp(ji,jj) = (zriver(ji,jj)+zriverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) 
    503             nitdep(ji,jj) = 7.6 * zndepo(ji,jj)                  / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn ) 
    504          END DO 
    505       END DO 
    506       ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged) 
    507       CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. ) 
    508  
    509       rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 
    510       rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 
    511       nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 
    512  
    513  
    514       ! Coastal supply of iron 
    515       ! ------------------------- 
    516       DO jk = 1, jpkm1 
    517          ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
    518       END DO 
    519       CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged) 
    520  
    521       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2) ) )   & 
    522         &         CALL ctl_stop('p4z_sed_init: failed to release workspace arrays') 
    523  
     596         ironsed(:,:,:) = 0._wp 
     597      ENDIF 
     598      ! 
     599      IF( ll_sbc ) CALL p4z_sbc( nit000 )  
     600      ! 
     601      IF(lwp) THEN  
     602         WRITE(numout,*) 
     603         WRITE(numout,*) '    Total input of elements from river supply' 
     604         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     605         WRITE(numout,*) '    N Supply   : ', rivpo4input/7.6*1E3/1E12*14.,' TgN/yr' 
     606         WRITE(numout,*) '    Si Supply  : ', rivalkinput/6.*1E3/1E12*32.,' TgSi/yr' 
     607         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr' 
     608         WRITE(numout,*) '    DIC Supply : ', rivpo4input*2.631*1E3*12./1E12,'TgC/yr' 
     609         WRITE(numout,*)  
     610         WRITE(numout,*) '    Total input of elements from atmospheric supply' 
     611         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     612         WRITE(numout,*) '    N Supply   : ', nitdepinput/7.6*1E3/1E12*14.,' TgN/yr' 
     613         WRITE(numout,*)  
     614      ENDIF 
     615      ! 
     616      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed_init') 
     617      ! 
    524618   END SUBROUTINE p4z_sed_init 
    525619 
     
    529623      !!---------------------------------------------------------------------- 
    530624 
    531       ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj)       ,     & 
    532         &       rivinp(jpi,jpj)      , cotdep(jpi,jpj)     ,     & 
    533         &       nitdep(jpi,jpj)      , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
     625      ALLOCATE( dust  (jpi,jpj), rivinp(jpi,jpj)     , cotdep(jpi,jpj),      & 
     626        &       nitdep(jpi,jpj), ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
    534627 
    535628      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2715 r3294  
    22   !!====================================================================== 
    33   !!                         ***  MODULE p4zsink  *** 
    4    !! TOP :   PISCES Compute vertical flux of particulate matter due to gravitational sinking 
     4   !! TOP :  PISCES vertical flux of particulate matter due to gravitational sinking 
    55   !!====================================================================== 
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Change aggregation formula 
     9   !!---------------------------------------------------------------------- 
    810#if defined key_pisces 
    911   !!---------------------------------------------------------------------- 
    1012   !!   p4z_sink       :  Compute vertical flux of particulate matter due to gravitational sinking 
     13   !!   p4z_sink_init  :  Unitialisation of sinking speed parameters 
     14   !!   p4z_sink_alloc :  Allocate sinking speed variables 
    1115   !!---------------------------------------------------------------------- 
    12    USE trc 
    13    USE oce_trc         ! 
    14    USE sms_pisces 
    15    USE prtctl_trc 
    16    USE iom 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE prtctl_trc      !  print control for debugging 
     20   USE iom             !  I/O manager 
    1721 
    1822   IMPLICIT NONE 
     
    8084      !! ** Method  : - ??? 
    8185      !!--------------------------------------------------------------------- 
    82       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    83       USE wrk_nemo, ONLY:   znum3d => wrk_3d_2 
    8486      ! 
    8587      INTEGER, INTENT(in) :: kt, jnt 
     
    9193      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9294      REAL(wp) :: zval1, zval2, zval3, zval4 
    93 #if defined key_diatrc 
    9495      REAL(wp) :: zrfact2 
    9596      INTEGER  :: ik1 
    96 #endif 
    9797      CHARACTER (len=25) :: charout 
    98       !!--------------------------------------------------------------------- 
    99       ! 
    100       IF( wrk_in_use(3, 2 ) ) THEN 
    101          CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')   ;   RETURN 
    102       ENDIF 
    103        
     98      REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d  
     99      !!--------------------------------------------------------------------- 
     100      ! 
     101      IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
     102      ! 
     103      CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
     104      ! 
    104105      !     Initialisation of variables used to compute Sinking Speed 
    105106      !     --------------------------------------------------------- 
     
    193194                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    & 
    194195                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    195                      &            * (zeps-1.)**2/(zdiv2*zdiv3))            & 
    196 # if defined key_degrad 
    197                      &                 *facvol(ji,jj,jk)       & 
    198 # endif 
    199                      &    ) 
    200  
    201                   zagg2 = (  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
     196                     &            * (zeps-1.)**2/(zdiv2*zdiv3))  
     197                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
    202198                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          & 
    203199                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 & 
     
    205201                     &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  & 
    206202                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           & 
    207                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))      & 
    208 #    if defined key_degrad 
    209                      &                 *facvol(ji,jj,jk)             & 
    210 #    endif 
    211                      &    ) 
    212  
    213                   zagg3 = (  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   & 
    214 #    if defined key_degrad 
    215                      &                 *facvol(ji,jj,jk)             & 
    216 #    endif 
    217                      &    ) 
    218  
    219                   zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    220  
     203                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))     
     204 
     205                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
     206                   
    221207                 !    Aggregation of small into large particles 
    222208                 !    Part II : Differential settling 
    223209                 !    ---------------------------------------------- 
    224210 
    225                   zagg4 = ( 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
     211                  zagg4 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    226212                     &                 xkr_wsbio_min*(zeps-1.)**2                         & 
    227213                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      & 
    228214                     &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       & 
    229215                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     & 
    230                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )                     & 
    231 # if defined key_degrad 
    232                      &                 *facvol(ji,jj,jk)        & 
    233 # endif 
    234                      &    ) 
    235  
    236                   zagg5 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
     216                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )    
     217 
     218                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
    237219                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        & 
    238220                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         & 
    239221                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    & 
    240                      &                 /zdiv)                   & 
    241 # if defined key_degrad 
    242                      &                 *facvol(ji,jj,jk)        & 
    243 # endif 
    244                      &    ) 
    245  
     222                     &                 /zdiv)   
    246223                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
    247224 
     
    253230                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    254231                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    & 
     232                     &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     233 
    255234# if defined key_degrad 
    256                      &        * facvol(ji,jj,jk)                              & 
     235                   zagg1   = zagg1   * facvol(ji,jj,jk)                  
     236                   zagg2   = zagg2   * facvol(ji,jj,jk)                  
     237                   zagg3   = zagg3   * facvol(ji,jj,jk)                  
     238                   zagg4   = zagg4   * facvol(ji,jj,jk)                  
     239                   zagg5   = zagg5   * facvol(ji,jj,jk)                  
     240                   zaggdoc = zaggdoc * facvol(ji,jj,jk)                  
    257241# endif 
    258                      &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    259  
     242                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
     243                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
     244                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
     245                  ! 
    260246                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    261247                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc 
     
    268254      END DO 
    269255 
    270 #if defined key_diatrc 
    271       zrfact2 = 1.e3 * rfact2r 
    272       ik1 = iksed + 1 
    273 #  if ! defined key_iomput 
    274       trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    275       trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    276       trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    277       trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    278       trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    279       trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
    280       trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
    281       trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
    282       trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
    283       trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
    284       trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
    285       trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
    286 #else 
    287       IF( jnt == nrdttrc ) then 
    288         CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
    289         CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
    290         CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
    291         CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
    292         CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
    293         CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
    294         CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
    295         CALL iom_put( "PMO"     , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
    296         CALL iom_put( "PMO2"    , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
    297         CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
    298         CALL iom_put( "ExpSi"   , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
    299         CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
    300      ENDIF 
    301 #  endif 
    302  
    303 #endif 
     256      IF( ln_diatrc ) THEN 
     257         ! 
     258         ik1 = iksed + 1 
     259         zrfact2 = 1.e3 * rfact2r 
     260         IF( jnt == nrdttrc ) THEN 
     261           CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
     262           CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
     263           CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
     264           CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
     265           CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
     266           CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
     267           CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
     268           CALL iom_put( "PMO"     , sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
     269           CALL iom_put( "PMO2"    , sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
     270           CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
     271           CALL iom_put( "ExpSi"   , sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
     272           CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
     273         ENDIF 
     274# if ! defined key_iomput 
     275         trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     276         trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     277         trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     278         trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     279         trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     280         trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
     281         trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
     282         trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
     283         trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
     284         trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
     285         trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
     286         trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
     287# endif 
     288        ! 
     289      ENDIF 
    304290      ! 
    305291      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    309295      ENDIF 
    310296      ! 
    311       IF( wrk_not_released(3, 2 ) )   CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     297      CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
     298      ! 
     299      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
    312300      ! 
    313301   END SUBROUTINE p4z_sink 
     
    335323      !!---------------------------------------------------------------------- 
    336324      ! 
    337       REWIND( numnat )                     ! read nampiskrs 
    338       READ  ( numnat, nampiskrs ) 
     325      IF( nn_timing == 1 )  CALL timing_start('p4z_sink_init') 
     326      ! 
     327      REWIND( numnatp )                     ! read nampiskrs 
     328      READ  ( numnatp, nampiskrs ) 
    339329 
    340330      IF(lwp) THEN 
     
    441431      END DO 
    442432      ! 
     433      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink_init') 
     434      ! 
    443435  END SUBROUTINE p4z_sink_init 
    444436 
     
    457449      INTEGER  ::   ji, jj, jk 
    458450      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    459       REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    460       REAL(wp) ::   zfact, zwsmax, zstep 
    461 #if defined key_diatrc 
     451      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 
     452      REAL(wp) ::   zfact, zwsmax, zmax, zstep 
    462453      REAL(wp) ::   zrfact2 
    463454      INTEGER  ::   ik1 
    464 #endif 
    465455      CHARACTER (len=25) :: charout 
    466456      !!--------------------------------------------------------------------- 
    467  
     457      ! 
     458      IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
     459      ! 
    468460      !    Sinking speeds of detritus is increased with depth as shown 
    469461      !    by data and from the coagulation theory 
     
    471463      DO jk = 1, jpkm1 
    472464         DO jj = 1, jpj 
    473             DO ji=1,jpi 
    474                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 
     465            DO ji = 1,jpi 
     466      !         zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
     467      !         zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 
     468               zmax = hmld(ji,jj) 
     469               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 4000._wp 
    475470               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    476471            END DO 
     
    526521         DO jj = 1, jpj 
    527522            DO ji = 1, jpi 
     523               ! 
     524               zstep = xstep  
    528525# if defined key_degrad 
    529                zstep = xstep * facvol(ji,jj,jk) 
    530 # else 
    531                zstep = xstep  
     526               zstep = zstep * facvol(ji,jj,jk) 
    532527# endif 
    533528               zfact = zstep * xdiss(ji,jj,jk) 
    534529               !  Part I : Coagulation dependent on turbulence 
    535                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    536                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     530               zagg1 = 354.  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     531               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    537532 
    538533               ! Part II : Differential settling 
    539534 
    540535               !  Aggregation of small into large particles 
    541                zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    542                zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     536               zagg3 =  4.7 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     537               zagg4 =  0.4 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    543538 
    544539               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
     
    546541 
    547542               ! Aggregation of DOC to small particles 
    548                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc)  
    549                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     543               zaggdoc  = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 
     544               zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     545               zaggdoc3 =   0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 
    550546 
    551547               !  Update the trends 
    552                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
     548               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    553549               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    554550               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    555551               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    556                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 
     552               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    557553               ! 
    558554            END DO 
     
    560556      END DO 
    561557 
    562 #if defined key_diatrc 
    563       zrfact2 = 1.e3 * rfact2r 
    564       ik1  = iksed + 1 
    565 #  if ! defined key_iomput 
    566       trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    567       trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    568       trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    569       trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    570       trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    571       trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    572 #  else 
    573       IF( jnt == nrdttrc )  then 
    574          CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
    575          CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
    576          CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
    577          CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     558      IF( ln_diatrc ) THEN 
     559         zrfact2 = 1.e3 * rfact2r 
     560         ik1  = iksed + 1 
     561         IF( lk_iomput ) THEN 
     562           IF( jnt == nrdttrc ) THEN 
     563              CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
     564              CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
     565              CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
     566              CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     567           ENDIF 
     568         ELSE 
     569           trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     570           trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     571           trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     572           trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     573           trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     574           trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     575         ENDIF 
    578576      ENDIF 
    579 #endif 
    580 #endif 
    581577      ! 
    582578      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    586582      ENDIF 
    587583      ! 
     584      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
     585      ! 
    588586   END SUBROUTINE p4z_sink 
    589  
    590587 
    591588   SUBROUTINE p4z_sink_init 
     
    597594#endif 
    598595 
     596 
     597 
    599598   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra ) 
    600599      !!--------------------------------------------------------------------- 
     
    608607      !!      transport term, i.e.  div(u*tra). 
    609608      !!--------------------------------------------------------------------- 
    610       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    611       USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 
    612609      ! 
    613610      INTEGER , INTENT(in   )                         ::   jp_tra    ! tracer index index       
     
    617614      INTEGER  ::   ji, jj, jk, jn 
    618615      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    619       !!--------------------------------------------------------------------- 
    620  
    621       IF(  wrk_in_use(3, 2,3,4 ) ) THEN 
    622          CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 
    623          RETURN 
    624       END IF 
     616      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2  
     617      !!--------------------------------------------------------------------- 
     618      ! 
     619      IF( nn_timing == 1 )  CALL timing_start('p4z_sink2') 
     620      ! 
     621      ! Allocate temporary workspace 
     622      CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 
    625623 
    626624      zstep = rfact2 / 2. 
     
    630628 
    631629      DO jk = 1, jpkm1 
    632 # if defined key_degrad 
    633          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 
    634 # else 
    635          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 
    636 # endif 
     630         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)  
    637631      END DO 
    638632      zwsink2(:,:,1) = 0.e0 
     633      IF( lk_degrad ) THEN 
     634         zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:) 
     635      ENDIF 
    639636 
    640637 
     
    706703      psinkflx(:,:,:)        = 2. * psinkflx(:,:,:) 
    707704      ! 
    708       IF( wrk_not_released(3, 2,3,4) )   CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
     705      CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 
     706      ! 
     707      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink2') 
    709708      ! 
    710709   END SUBROUTINE p4z_sink2 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r2528 r3294  
    2929   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    3030   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_diatrc') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_diatrc') 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output  
     32   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output  
    3333   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES 
    3434 
     
    6767   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_diatrc') 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_diatrc') 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output  
     70   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output  
    7171   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES 
    7272 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2715 r3294  
    1717   PUBLIC 
    1818 
     19   INTEGER ::   numnatp 
     20 
    1921   !!*  Time variables 
    2022   INTEGER  ::   nrdttrc           !: ??? 
     
    2527 
    2628   !!*  Biological parameters  
    27    REAL(wp) ::   part              !: ??? 
    2829   REAL(wp) ::   rno3              !: ??? 
    2930   REAL(wp) ::   o2ut              !: ??? 
    3031   REAL(wp) ::   po4r              !: ??? 
    3132   REAL(wp) ::   rdenit            !: ??? 
     33   REAL(wp) ::   rdenita           !: ??? 
    3234   REAL(wp) ::   o2nit             !: ??? 
    3335   REAL(wp) ::   wsbio, wsbio2     !: ??? 
     
    3739   !!* Damping  
    3840   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
     41   INTEGER  ::   nn_pisdmp         !: frequency of relaxation or not of nutrients to a mean value 
    3942   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    4043                                   !: on close seas 
     
    5558   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ??? 
    5659   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ??? 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ??? 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     63 
    5764 
    5865   !!*  SMS for the organic matter 
     
    6168   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
    6269   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    63 #if defined key_diatrc 
    64    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    66 #endif 
     70    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
     71    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    6772 
    6873   !!* Variable for chemistry of the CO2 cycle 
     
    7479   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
    7580   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
     81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ??? 
     82 
     83   !!* Temperature dependancy of SMS terms 
     84   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    7686 
    7787   !!* Array used to indicate negative tracer values 
     
    98108      !!---------------------------------------------------------------------- 
    99109      USE lib_mpp , ONLY: ctl_warn 
    100       INTEGER ::   ierr(5)        ! Local variables 
     110      INTEGER ::   ierr(6)        ! Local variables 
    101111      !!---------------------------------------------------------------------- 
    102112      ierr(:) = 0 
    103       ! 
    104113      !*  Biological fluxes for light 
    105       ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
     114      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                   STAT=ierr(1) ) 
    106115      ! 
    107116      !*  Biological fluxes for primary production 
    108       ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
    109          &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),               & 
    110          &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),               & 
    111          &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
    112          &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
     117      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,       & 
     118         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
     119         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
     120         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       & 
     121         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
     122         &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
     123         &      concnfe (jpi,jpj,jpk),                          STAT=ierr(2) )  
    113124         ! 
    114125      !*  SMS for the organic matter 
    115       ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
    116 #if defined key_diatrc 
    117          &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) ,               & 
    118 #endif  
    119          &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
     126      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       & 
     127         &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk),       & 
     128         &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),   STAT=ierr(3) )   
    120129         ! 
    121130      !* Variable for chemistry of the CO2 cycle 
    122       ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
    123          &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
    124          &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
     131      ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       & 
     132         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       & 
     133         &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       & 
     134         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,   STAT=ierr(4) ) 
     135         ! 
     136      !* Temperature dependancy of SMS terms 
     137      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,   STAT=ierr(5) ) 
    125138         ! 
    126139      !* Array used to indicate negative tracer values   
    127       ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
     140      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                          STAT=ierr(6) ) 
    128141      ! 
    129142      sms_pisces_alloc = MAXVAL( ierr ) 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2715 r3294  
    1717   !!---------------------------------------------------------------------- 
    1818   USE par_trc         ! TOP parameters 
    19    USE sms_pisces      ! Source Minus Sink variables 
    20    USE trc 
    21    USE oce_trc         ! ocean variables 
    22    USE p4zche  
    23    USE p4zche          !  
    24    USE p4zsink         !  
    25    USE p4zopt          !  
    26    USE p4zprod         ! 
    27    USE p4zrem          !  
    28    USE p4zsed          !  
    29    USE p4zflx          !  
     19   USE oce_trc         !  shared variables between ocean and passive tracers 
     20   USE trc             !  passive tracers common variables  
     21   USE sms_pisces      !  PISCES Source Minus Sink variables 
     22   USE p4zche          !  Chemical model 
     23   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     24   USE p4zopt          !  optical model 
     25   USE p4zrem          !  Remineralisation of organic matter 
     26   USE p4zflx          !  Gas exchange 
     27   USE p4zsed          !  Sedimentation 
     28   USE p4zlim          !  Co-limitations of differents nutrients 
     29   USE p4zprod         !  Growth rate of the 2 phyto groups 
     30   USE p4zmicro        !  Sources and sinks of microzooplankton 
     31   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     32   USE p4zmort         !  Mortality terms for phytoplankton 
     33   USE p4zlys          !  Calcite saturation 
     34   USE p4zsed          !  Sedimentation 
    3035 
    3136   IMPLICIT NONE 
     
    4045   REAL(wp) :: bioma0 =  1.000e-8_wp   
    4146   REAL(wp) :: silic1 =  91.65e-6_wp   
    42    REAL(wp) :: no3    =  31.04e-6_wp * 7.6_wp 
     47   REAL(wp) :: no3    =  31.04e-6_wp * 7.625_wp 
    4348 
    4449#  include "top_substitute.h90" 
     
    5762      !!---------------------------------------------------------------------- 
    5863      ! 
     64      INTEGER  ::  ji, jj, jk 
     65      REAL(wp) ::  zcaralk, zbicarb, zco3 
     66      REAL(wp) ::  ztmas, ztmas1 
     67      !!---------------------------------------------------------------------- 
    5968      IF(lwp) WRITE(numout,*) 
    6069      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
     
    7685      ! Set biological ratios 
    7786      ! --------------------- 
    78       rno3   = (16.+2.) / 122. 
    79       po4r   =   1.e0   / 122. 
    80       o2nit  =  32.     / 122. 
    81       rdenit =  97.6    /  16. 
    82       o2ut   = 140.     / 122. 
     87      rno3    =  16._wp / 122._wp 
     88      po4r    =   1._wp / 122._wp 
     89      o2nit   =  32._wp / 122._wp 
     90      rdenit  = 105._wp /  16._wp 
     91      rdenita =   3._wp /  5._wp 
     92      o2ut    = 131._wp / 122._wp 
    8393 
    8494      CALL p4z_che        ! initialize the chemical constants 
     
    124134      ENDIF 
    125135 
     136      IF( .NOT. ln_rsttr ) THEN 
     137         ! Initialization of chemical variables of the carbon cycle 
     138         ! -------------------------------------------------------- 
     139         DO jk = 1, jpk 
     140            DO jj = 1, jpj 
     141               DO ji = 1, jpi 
     142                  ztmas   = tmask(ji,jj,jk) 
     143                  ztmas1  = 1. - tmask(ji,jj,jk) 
     144                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     145                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     146                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     147                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     148               END DO 
     149            END DO 
     150         END DO 
     151         ! 
     152      END IF 
     153 
     154      ! Time step duration for biology 
     155      xstep = rfact2 / rday 
     156 
     157      CALL p4z_sink_init      !  vertical flux of particulate organic matter 
     158      CALL p4z_opt_init       !  Optic: PAR in the water column 
     159      CALL p4z_lim_init       !  co-limitations by the various nutrients 
     160      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
     161      CALL p4z_rem_init       !  remineralisation 
     162      CALL p4z_mort_init      !  phytoplankton mortality  
     163      CALL p4z_micro_init     !  microzooplankton 
     164      CALL p4z_meso_init      !  mesozooplankton 
     165      CALL p4z_sed_init       !  sedimentation  
     166      CALL p4z_lys_init       !  calcite saturation 
     167      CALL p4z_flx_init       !  gas exchange  
     168 
     169      ndayflxtr = 0 
     170 
     171      IF(lwp) WRITE(numout,*)  
    126172      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    127       IF(lwp) WRITE(numout,*) ' ' 
     173      IF(lwp) WRITE(numout,*)  
    128174      ! 
    129175   END SUBROUTINE trc_ini_pisces 
     
    136182      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    137183      !!---------------------------------------------------------------------- 
    138       USE p4zint , ONLY : p4z_int_alloc       
    139       USE p4zsink, ONLY : p4z_sink_alloc       
    140       USE p4zopt , ONLY : p4z_opt_alloc            
    141       USE p4zprod, ONLY : p4z_prod_alloc          
    142       USE p4zrem , ONLY : p4z_rem_alloc            
    143       USE p4zsed , ONLY : p4z_sed_alloc           
    144       USE p4zflx , ONLY : p4z_flx_alloc 
    145184      ! 
    146185      INTEGER :: ierr 
     
    148187      ! 
    149188      ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines... 
    150       ierr = ierr +     p4z_che_alloc() 
    151       ierr = ierr +     p4z_int_alloc() 
    152       ierr = ierr +    p4z_sink_alloc() 
    153       ierr = ierr +     p4z_opt_alloc() 
    154       ierr = ierr +    p4z_prod_alloc() 
    155       ierr = ierr +     p4z_rem_alloc() 
    156       ierr = ierr +     p4z_sed_alloc() 
    157       ierr = ierr +     p4z_flx_alloc() 
     189      ierr = ierr +  p4z_che_alloc() 
     190      ierr = ierr +  p4z_sink_alloc() 
     191      ierr = ierr +  p4z_opt_alloc() 
     192      ierr = ierr +  p4z_prod_alloc() 
     193      ierr = ierr +  p4z_rem_alloc() 
     194      ierr = ierr +  p4z_sed_alloc() 
     195      ierr = ierr +  p4z_flx_alloc() 
    158196      ! 
    159197      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r2715 r3294  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
     21   USE iom             ! I/O manager 
    2122 
    2223 
     
    4647      !!---------------------------------------------------------------------- 
    4748      !! 
    48 #if defined key_diatrc && ! defined key_iomput 
    49       INTEGER ::  jl, jn 
    50       ! definition of additional diagnostic as a structure 
    51       TYPE DIAG 
    52          CHARACTER(len = 20)  :: snamedia   !: short name 
    53          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    54          CHARACTER(len = 20 ) :: unitdia    !: unit 
    55       END TYPE DIAG 
    56  
    57       TYPE(DIAG) , DIMENSION(jp_pisces_2d) :: pisdia2d 
    58       TYPE(DIAG) , DIMENSION(jp_pisces_3d) :: pisdia3d 
    59 #endif 
    60  
    61       NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2 
     49      INTEGER :: jl, jn 
     50      TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 
     51      TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 
     52      !! 
     53      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2 
    6254#if defined key_kriest 
    6355      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max 
    6456#endif 
    65 #if defined key_diatrc && ! defined key_iomput 
    66       NAMELIST/nampisdia/ nn_writedia, pisdia3d, pisdia2d     ! additional diagnostics 
    67 #endif 
    68       NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 
     57      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
     58      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo 
    6959 
    7060      !!---------------------------------------------------------------------- 
     
    7767      !                               ! Open the namelist file 
    7868      !                               ! ---------------------- 
    79       CALL ctl_opn( numnat, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     69      CALL ctl_opn( numnatp, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    8070 
    81       REWIND( numnat )                     
    82       READ  ( numnat, nampisbio ) 
     71      REWIND( numnatp )                     
     72      READ  ( numnatp, nampisbio ) 
    8373 
    8474      IF(lwp) THEN                         ! control print 
    8575         WRITE(numout,*) ' Namelist : nampisbio' 
    86          WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part 
    8776         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
    8877         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
     
    10190      xkr_mass_max = 1.       
    10291 
    103       REWIND( numnat )                     ! read natkriest 
    104       READ  ( numnat, nampiskrp ) 
     92      REWIND( numnatp )                     ! read natkriest 
     93      READ  ( numnatp, nampiskrp ) 
    10594 
    10695      IF(lwp) THEN 
     
    120109#endif 
    121110      ! 
    122 #if defined key_diatrc && ! defined key_iomput 
     111      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     112         ! 
     113         ! Namelist nampisdia 
     114         ! ------------------- 
     115         DO jl = 1, jp_pisces_2d 
     116            WRITE(pisdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     117            WRITE(pisdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     118            pisdia2d(jl)%units = ' '                                       ! units 
     119         END DO 
     120         !                                 ! 3D output arrays 
     121         DO jl = 1, jp_pisces_3d 
     122            WRITE(pisdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     123            WRITE(pisdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     124            pisdia3d(jl)%units = ' '                                       ! units 
     125         END DO 
    123126 
    124       ! Namelist namlobdia 
    125       ! ------------------- 
    126       nn_writedia = 10                   ! default values 
    127  
    128       DO jl = 1, jp_pisces_2d 
    129          jn = jp_pcs0_2d + jl - 1 
    130          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    131          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    132          ctrc2u(jn) = ' '                                       ! units 
    133       END DO 
    134       !                                 ! 3D output arrays 
    135       DO jl = 1, jp_pisces_3d 
    136          jn = jp_pcs0_3d + jl - 1 
    137          WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name 
    138          WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    139          ctrc3u(jn) = ' '                                       ! units 
    140       END DO 
    141  
    142       REWIND( numnat )               ! read natrtd 
    143       READ  ( numnat, nampisdia ) 
    144  
    145       DO jl = 1, jp_pisces_2d 
    146          jn = jp_pcs0_2d + jl - 1 
    147          ctrc2d(jn) = pisdia2d(jl)%snamedia 
    148          ctrc2l(jn) = pisdia2d(jl)%lnamedia 
    149          ctrc2u(jn) = pisdia2d(jl)%unitdia 
    150       END DO 
    151  
    152       DO jl = 1, jp_pisces_3d 
    153          jn = jp_pcs0_3d + jl - 1 
    154          ctrc3d(jn) = pisdia3d(jl)%snamedia 
    155          ctrc3l(jn) = pisdia3d(jl)%lnamedia 
    156          ctrc3u(jn) = pisdia3d(jl)%unitdia 
    157       END DO 
    158  
    159       IF(lwp) THEN                   ! control print 
    160          WRITE(numout,*) 
    161          WRITE(numout,*) ' Namelist : natadd' 
    162          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
    163          DO jl = 1, jp_pisces_3d 
    164             jn = jp_pcs0_3d + jl - 1 
    165             WRITE(numout,*) '   3d output field No : ',jn 
    166             WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn)) 
    167             WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn)) 
    168             WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn)) 
    169             WRITE(numout,*) ' ' 
    170          END DO 
     127         REWIND( numnatp )               !  
     128         READ  ( numnatp, nampisdia ) 
    171129 
    172130         DO jl = 1, jp_pisces_2d 
    173131            jn = jp_pcs0_2d + jl - 1 
    174             WRITE(numout,*) '   2d output field No : ',jn 
    175             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    176             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    177             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     132            ctrc2d(jn) = pisdia2d(jl)%sname 
     133            ctrc2l(jn) = pisdia2d(jl)%lname 
     134            ctrc2u(jn) = pisdia2d(jl)%units 
     135         END DO 
     136 
     137         DO jl = 1, jp_pisces_3d 
     138            jn = jp_pcs0_3d + jl - 1 
     139            ctrc3d(jn) = pisdia3d(jl)%sname 
     140            ctrc3l(jn) = pisdia3d(jl)%lname 
     141            ctrc3u(jn) = pisdia3d(jl)%units 
     142         END DO 
     143 
     144         IF(lwp) THEN                   ! control print 
     145            WRITE(numout,*) 
     146            WRITE(numout,*) ' Namelist : natadd' 
     147            DO jl = 1, jp_pisces_3d 
     148               jn = jp_pcs0_3d + jl - 1 
     149               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     150                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     151            END DO 
    178152            WRITE(numout,*) ' ' 
    179          END DO 
     153 
     154            DO jl = 1, jp_pisces_2d 
     155               jn = jp_pcs0_2d + jl - 1 
     156               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     157                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     158            END DO 
     159            WRITE(numout,*) ' ' 
     160         ENDIF 
     161         ! 
    180162      ENDIF 
    181 #endif 
    182163 
    183       REWIND( numnat ) 
    184       READ  ( numnat, nampisdmp ) 
     164      REWIND( numnatp ) 
     165      READ  ( numnatp, nampisdmp ) 
    185166 
    186167      IF(lwp) THEN                         ! control print 
    187168         WRITE(numout,*) 
    188169         WRITE(numout,*) ' Namelist : nampisdmp' 
    189          WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp 
     170         WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
     171         WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    190172         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    191173         WRITE(numout,*) ' ' 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2715 r3294  
    4343 
    4444      ! 
    45       IF( lk_dtatrc .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas 
    46       IF( ln_pisdmp )                 CALL pis_dmp_ini  ! relaxation of some tracers 
     45      IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas 
    4746      ! 
    4847      IF(lwp) WRITE(numout,*) 
     
    5352         CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    5453      ELSE 
     54!         hi(:,:,:) = 1.e-9  
    5555         ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???) 
    5656         ! -------------------------------------------------------- 
     
    6363                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    6464                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    65                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     65                 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    6666               END DO 
    6767            END DO 
     
    9999   END SUBROUTINE trc_rst_wri_pisces 
    100100 
    101    SUBROUTINE pis_dmp_ini 
    102       !!---------------------------------------------------------------------- 
    103       !!                    ***  pis_dmp_ini  *** 
    104       !! 
    105       !! ** purpose  : Relaxation of some tracers 
    106       !!---------------------------------------------------------------------- 
    107       REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    108       REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
    109       REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
    110       REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
    111  
    112       REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
    113  
    114  
    115       IF(lwp)  WRITE(numout,*) 
    116  
    117       IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    118          !                                                    ! --------------------------- ! 
    119          ! set total alkalinity, phosphate, nitrate & silicate 
    120  
    121          zarea   = 1. / areatot * 1.e6 
    122 # if defined key_degrad 
    123          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
    124          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122. 
    125          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6 
    126          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
    127 # else 
    128          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    129          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
    130          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
    131          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    132 # endif 
    133  
    134          IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    135          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
    136              
    137          IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
    138          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
    139  
    140          IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
    141          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
    142  
    143          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
    144          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
    145          ! 
    146       ENDIF 
    147  
    148 !#if defined key_kriest 
    149 !     !! Initialize number of particles from a standart restart file 
    150 !     !! The name of big organic particles jpgoc has been only change 
    151 !     !! and replace by jpnum but the values here are concentration 
    152 !     trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)  
    153 !     trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    154 !#endif 
    155  
    156    END SUBROUTINE pis_dmp_ini 
    157  
    158101   SUBROUTINE pis_dmp_clo    
    159102      !!--------------------------------------------------------------------- 
     
    168111      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j) 
    169112      !!---------------------------------------------------------------------- 
    170       INTEGER, PARAMETER           ::   npicts   = 4       !: number of closed sea 
    171       INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1     !: south-west closed sea limits (i,j) 
    172       INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2     !: north-east closed sea limits (i,j) 
    173       INTEGER :: ji, jj, jk, jn, jc            ! dummy loop indices 
     113      INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea 
     114      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j) 
     115      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j) 
     116      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices 
     117      INTEGER :: ierr                                       ! local integer 
     118      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta ! 4D  workspace 
    174119      !!---------------------------------------------------------------------- 
    175120 
     
    243188      END DO 
    244189 
    245 #if defined key_dtatrc 
    246190      ! Restore close seas values to initial data 
    247       CALL trc_dta( nit000 )  
    248       DO jn = 1, jptra 
    249          IF( lutini(jn) ) THEN 
    250             DO jc = 1, npicts 
    251                DO jk = 1, jpkm1 
    252                   DO jj = ictsj1(jc), ictsj2(jc) 
    253                      DO ji = ictsi1(jc), ictsi2(jc) 
    254                         trn(ji,jj,jk,jn) = trdta(ji,jj,jk,jn) * tmask(ji,jj,jk)  
    255                         trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    256                      ENDDO 
    257                   ENDDO 
    258                ENDDO 
    259             ENDDO 
    260          ENDIF 
    261       ENDDO 
    262 #endif 
    263    ! 
     191      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     192        ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr ) 
     193        IF( ierr > 0 ) THEN 
     194           CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN 
     195        ENDIF 
     196        ! 
     197        CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000 
     198        ! 
     199        DO jn = 1, jptra 
     200           IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     201              jl = n_trc_index(jn) 
     202              DO jc = 1, npicts 
     203                 DO jk = 1, jpkm1 
     204                    DO jj = ictsj1(jc), ictsj2(jc) 
     205                       DO ji = ictsi1(jc), ictsi2(jc) 
     206                          trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)  
     207                          trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     208                       ENDDO 
     209                    ENDDO 
     210                 ENDDO 
     211              ENDDO 
     212           ENDIF 
     213        ENDDO 
     214        DEALLOCATE( ztrcdta ) 
     215      ENDIF 
     216      ! 
    264217   END SUBROUTINE pis_dmp_clo 
    265218 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2715 r3294  
    1313   !!   trcsms_pisces        :  Time loop of passive tracers sms 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
    16    USE trc 
    17    USE sms_pisces 
    18     
    19    USE p4zint          !  
    20    USE p4zche          !  
    21    USE p4zbio          !  
    22    USE p4zsink         !  
    23    USE p4zopt          !  
    24    USE p4zlim          !  
    25    USE p4zprod         ! 
    26    USE p4zmort         ! 
    27    USE p4zmicro        !  
    28    USE p4zmeso         !  
    29    USE p4zrem          !  
    30    USE p4zsed          !  
    31    USE p4zlys          !  
    32    USE p4zflx          !  
    33  
    34    USE prtctl_trc 
    35  
    36    USE trdmod_oce 
    37    USE trdmod_trc 
    38  
    39    USE sedmodel 
     15   USE oce_trc         !  shared variables between ocean and passive tracers 
     16   USE trc             !  passive tracers common variables  
     17   USE sms_pisces      !  PISCES Source Minus Sink variables 
     18   USE p4zbio          !  Biological model 
     19   USE p4zche          !  Chemical model 
     20   USE p4zlys          !  Calcite saturation 
     21   USE p4zflx          !  Gas exchange 
     22   USE p4zsed          !  Sedimentation 
     23   USE p4zint          !  time interpolation 
     24   USE trdmod_oce      !  Ocean trends variables 
     25   USE trdmod_trc      !  TOP trends variables 
     26   USE sedmodel        !  Sediment model 
     27   USE prtctl_trc      !  print control for debugging 
    4028 
    4129   IMPLICIT NONE 
     
    4331 
    4432   PUBLIC   trc_sms_pisces    ! called in trcsms.F90 
     33 
     34   LOGICAL ::  ln_check_mass = .false.       !: Flag to check mass conservation  
     35 
     36   INTEGER ::  numno3  !: logical unit for NO3 budget 
     37   INTEGER ::  numalk  !: logical unit for talk budget 
     38   INTEGER ::  numsil  !: logical unit for Si budget 
    4539 
    4640   !!---------------------------------------------------------------------- 
     
    6357      !!              - ... 
    6458      !!--------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: ztrpis => wrk_3d_1   ! used for pisces sms trends 
    6759      ! 
    6860      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     
    7163      CHARACTER (len=25) :: charout 
    7264      !!--------------------------------------------------------------------- 
    73  
    74       IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    75  
    76       IF( wrk_in_use(3,1) )  THEN 
    77         CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.')  ;  RETURN 
    78       ENDIF 
     65      ! 
     66      IF( nn_timing == 1 )  CALL timing_start('trc_sms_pisces') 
     67      ! 
     68      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
     69                                                                   CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking 
    7970 
    8071      IF( ndayflxtr /= nday_year ) THEN      ! New days 
     
    8677         IF(lwp) write(numout,*) '~~~~~~' 
    8778 
    88          CALL p4z_che          ! computation of chemical constants 
    89          CALL p4z_int          ! computation of various rates for biogeochemistry 
     79         CALL p4z_che              ! computation of chemical constants 
     80         CALL p4z_int              ! computation of various rates for biogeochemistry 
    9081         ! 
    9182      ENDIF 
     
    109100      END DO 
    110101 
    111  
    112102      IF( l_trdtrc ) THEN 
    113103          DO jn = jp_pcs0, jp_pcs1 
    114             ztrpis(:,:,:) = tra(:,:,:,jn) 
    115             CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
     104            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    116105          END DO 
    117           DEALLOCATE( ztrpis ) 
    118106      END IF 
    119107 
     
    127115         ! 
    128116      ENDIF 
    129  
    130       IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.')  
    131  
     117      ! 
     118      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_pisces') 
     119      ! 
    132120   END SUBROUTINE trc_sms_pisces 
    133121 
    134    SUBROUTINE trc_sms_pisces_init 
     122   SUBROUTINE trc_sms_pisces_dmp( kt ) 
    135123      !!---------------------------------------------------------------------- 
    136       !!                  ***  ROUTINE trc_sms_pisces_init  *** 
    137       !! 
    138       !! ** Purpose :   Initialization of PH variable 
    139       !! 
     124      !!                    ***  trc_sms_pisces_dmp  *** 
     125      !! 
     126      !! ** purpose  : Relaxation of some tracers 
    140127      !!---------------------------------------------------------------------- 
    141       INTEGER  ::  ji, jj, jk 
    142       REAL(wp) ::  zcaralk, zbicarb, zco3 
    143       REAL(wp) ::  ztmas, ztmas1 
    144  
    145       IF( .NOT. ln_rsttr ) THEN 
    146          ! Initialization of chemical variables of the carbon cycle 
    147          ! -------------------------------------------------------- 
    148          DO jk = 1, jpk 
    149             DO jj = 1, jpj 
    150                DO ji = 1, jpi 
    151                   ztmas   = tmask(ji,jj,jk) 
    152                   ztmas1  = 1. - tmask(ji,jj,jk) 
    153                   zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    154                   zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    155                   zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    156                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    157                END DO 
    158             END DO 
    159          END DO 
    160          ! 
    161       END IF 
    162  
    163       ! Time step duration for biology 
    164       xstep = rfact2 / rday 
    165  
    166       CALL p4z_sink_init      ! vertical flux of particulate organic matter 
    167       CALL p4z_opt_init       ! Optic: PAR in the water column 
    168       CALL p4z_lim_init       ! co-limitations by the various nutrients 
    169       CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
    170       CALL p4z_rem_init       ! remineralisation 
    171       CALL p4z_mort_init      ! phytoplankton mortality 
    172       CALL p4z_micro_init     ! microzooplankton 
    173       CALL p4z_meso_init      ! mesozooplankton 
    174       CALL p4z_sed_init       ! sedimentation 
    175       CALL p4z_lys_init       ! calcite saturation 
    176       CALL p4z_flx_init       ! gas exchange 
    177  
    178       ndayflxtr = 0 
    179  
    180    END SUBROUTINE trc_sms_pisces_init 
     128      ! 
     129      INTEGER, INTENT( in )  ::     kt ! time step 
     130      ! 
     131      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
     132      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
     133      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
     134      REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
     135      ! 
     136      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
     137      !!--------------------------------------------------------------------- 
     138 
     139 
     140      IF(lwp)  WRITE(numout,*) 
     141      IF(lwp)  WRITE(numout,*) ' trc_sms_pisces_dmp : Relaxation of nutrients at time-step kt = ', kt 
     142      IF(lwp)  WRITE(numout,*) 
     143 
     144      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     145         !                                                    ! --------------------------- ! 
     146         ! set total alkalinity, phosphate, nitrate & silicate 
     147         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
     148 
     149         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     150         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
     151         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
     152         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     153  
     154         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
     155         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
     156 
     157         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
     158         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
     159 
     160         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
     161         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
     162 
     163         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
     164         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
     165         ! 
     166      ENDIF 
     167 
     168   END SUBROUTINE trc_sms_pisces_dmp 
     169 
     170   SUBROUTINE trc_sms_pisces_mass_conserv ( kt ) 
     171      !!---------------------------------------------------------------------- 
     172      !!                  ***  ROUTINE trc_sms_pisces_mass_conserv  *** 
     173      !! 
     174      !! ** Purpose :  Mass conservation check  
     175      !! 
     176      !!--------------------------------------------------------------------- 
     177      ! 
     178      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     179      !! 
     180      REAL(wp) :: zalkbudget, zno3budget, zsilbudget 
     181      ! 
     182      NAMELIST/nampismass/ ln_check_mass 
     183      !!--------------------------------------------------------------------- 
     184 
     185      IF( kt == nittrc000 ) THEN  
     186         REWIND( numnatp )        
     187         READ  ( numnatp, nampismass ) 
     188         IF(lwp) THEN                         ! control print 
     189            WRITE(numout,*) ' ' 
     190            WRITE(numout,*) ' Namelist parameter for mass conservation checking' 
     191            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     192            WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 
     193         ENDIF 
     194 
     195         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si 
     196            CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     197            CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     198            CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     199         ENDIF 
     200      ENDIF 
     201 
     202      IF( ln_check_mass ) THEN      !   Compute the budget of NO3, ALK, Si 
     203         zno3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  & 
     204            &                     + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
     205            &                     + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
     206            &                     + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  & 
     207            &                     + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )  
     208         !  
     209         zsilbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpdsi)  & 
     210            &                     + trn(:,:,:,jpbsi)                     ) * cvol(:,:,:)  ) 
     211         !  
     212         zalkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              & 
     213            &                     + trn(:,:,:,jptal)                     & 
     214            &                     + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  ) 
     215 
     216         IF( lwp ) THEN 
     217            WRITE(numno3,9500) kt,  zno3budget / areatot 
     218            WRITE(numsil,9500) kt,  zsilbudget / areatot 
     219            WRITE(numalk,9500) kt,  zalkbudget / areatot 
     220         ENDIF 
     221       ENDIF 
     222 9500  FORMAT(i10,e18.10)      
     223       ! 
     224   END SUBROUTINE trc_sms_pisces_mass_conserv 
    181225 
    182226#else 
Note: See TracChangeset for help on using the changeset viewer.